Rewrite core-cli
Highlights:
- 'doom purge' now purges builds, elpa packages, and repos by default.
Regrafting repos is now opt-in with the -g/--regraft switches.
Negation flags have been added for elpa/repos: -e/--no-elpa and
-r/--no-repos.
- Removed 'doom rebuild' (it is now just 'doom build' or 'doom b').
- Removed 'doom build's -f flag, this is now the default. Added the -r
flag instead, which only builds packages that need rebuilding.
- 'doom update' now updates packages synchronously, but produces more
informative output about the updating process.
- Straight can now prompt in batch mode, which resolves a lot of issues
with 'doom update' (and 'doom upgrade') freezing indefinitely or
throwing repo branch errors.
- 'bin/doom's switches are now positional. Switches aimed at `bin/doom`
must precede any subcommands. e.g.
Do: 'doom -yd upgrade'
Don't do: 'doom upgrade -yd'
- Moved 'doom doctor' from bin/doom-doctor to core/cli/doctor, and
integrated core/doctor.el into it, as to avoid naming conflicts
between it and Emacs doctor.
- The defcli! macro now has a special syntax for declaring flags, their
arguments and descriptions.
Addresses #1981, #1925, #1816, #1721, #1322
This commit is contained in:
Henrik Lissner
parent
99cd52e70f
commit
873fc5c0db
16 changed files with 996 additions and 1266 deletions
171
bin/doom
171
bin/doom
|
|
@ -1,105 +1,79 @@
|
|||
#!/usr/bin/env sh
|
||||
":"; ( echo "$EMACS" | grep -q "term" ) && EMACS=emacs || EMACS=${EMACS:-emacs} # -*-emacs-lisp-*-
|
||||
":"; command -v $EMACS >/dev/null || { >&2 echo "Emacs isn't installed"; exit 1; }
|
||||
":"; VERSION=$($EMACS --version | head -n1)
|
||||
":"; case "$VERSION" in *\ 2[0-2].[0-1].[0-9]) echo "You're running $VERSION"; echo "That version is too old to run Doom. Check your PATH"; echo; exit 2 ;; esac
|
||||
":"; DOOMBASE=$(dirname "$0")/..
|
||||
":"; [ "$1" = -d ] || [ "$1" = --debug ] && { shift; export DEBUG=1; }
|
||||
":"; [ "$1" = doc ] || [ "$1" = doctor ] && { cd "$DOOMBASE"; shift; exec $EMACS --script bin/doom-doctor "$@"; exit 0; }
|
||||
":"; [ "$1" = run ] && { cd "$DOOMBASE"; shift; exec $EMACS -q --no-splash -l bin/doom "$@"; exit 0; }
|
||||
":"; exec $EMACS --script "$0" -- "$@"
|
||||
":"; exit 0
|
||||
:; ( echo "$EMACS" | grep -q "term" ) && EMACS=emacs || EMACS=${EMACS:-emacs} # -*-emacs-lisp-*-
|
||||
:; command -v $EMACS >/dev/null || { >&2 echo "Can't find emacs in your PATH"; exit 1; }
|
||||
:; VERSION=$($EMACS --version | head -n1)
|
||||
:; case "$VERSION" in *\ 2[0-5].[0-9]) echo "Detected Emacs $VERSION"; echo "Doom only supports Emacs 26.1 and newer"; echo; exit 2 ;; esac
|
||||
:; DOOMBASE="$(dirname "$0")/.."
|
||||
:; [ "$1" = -d ] || [ "$1" = --debug ] && { shift; export DEBUG=1; }
|
||||
:; [ "$1" = run ] && { cd "$DOOMBASE"; shift; exec $EMACS -q --no-splash -l bin/doom "$@"; exit 0; }
|
||||
:; exec $EMACS --script "$0" -- "$@"
|
||||
:; exit 0
|
||||
|
||||
(defconst user-emacs-directory
|
||||
(or (getenv "EMACSDIR")
|
||||
(expand-file-name "../" (file-name-directory (file-truename load-file-name)))))
|
||||
(let* ((loaddir (file-name-directory (file-truename load-file-name)))
|
||||
(emacsdir (getenv "EMACSDIR"))
|
||||
(user-emacs-directory (or emacsdir (expand-file-name "../" loaddir)))
|
||||
(load-prefer-newer t))
|
||||
|
||||
(defun usage ()
|
||||
(with-temp-buffer
|
||||
(insert (format! "%s %s [COMMAND] [ARGS...]\n"
|
||||
(bold "Usage:")
|
||||
(file-name-nondirectory load-file-name))
|
||||
"\n"
|
||||
"A command line interface for managing Doom Emacs; including\n"
|
||||
"package management, diagnostics, unit tests, and byte-compilation.\n"
|
||||
"\n"
|
||||
"This tool also makes it trivial to launch Emacs out of a different\n"
|
||||
"folder or with a different private module.\n"
|
||||
"\n"
|
||||
(format! (bold "Example:\n"))
|
||||
" doom install\n"
|
||||
" doom help update\n"
|
||||
" doom compile :core lang/php lang/python\n"
|
||||
" doom run\n"
|
||||
" doom run -nw file.txt file2.el\n"
|
||||
" doom run -p ~/.other.doom.d -e ~/.other.emacs.d -nw file.txt\n"
|
||||
"\n"
|
||||
(format! (bold "Options:\n"))
|
||||
" -h --help\t\tSame as help command\n"
|
||||
" -d --debug\t\tTurns on doom-debug-mode (and debug-on-error)\n"
|
||||
" -e --emacsd DIR\tUse the emacs config at DIR (e.g. ~/.emacs.d)\n"
|
||||
" -i --insecure\t\tDisable TLS/SSL validation (not recommended)\n"
|
||||
" -l --local DIR\tUse DIR as your local storage directory\n"
|
||||
" -p --private DIR\tUse the private module at DIR (e.g. ~/.doom.d)\n"
|
||||
" -y --yes\t\tAuto-accept all confirmation prompts\n\n")
|
||||
(princ (buffer-string)))
|
||||
(doom--dispatch-help))
|
||||
(push (expand-file-name "core" user-emacs-directory) load-path)
|
||||
(require 'core)
|
||||
(require 'core-cli)
|
||||
|
||||
;;
|
||||
(let ((args (cdr (cdr (cdr command-line-args)))))
|
||||
;; Parse options
|
||||
(while (ignore-errors (string-prefix-p "-" (car args)))
|
||||
(pcase (pop args)
|
||||
((or "-h" "--help")
|
||||
(push "help" args))
|
||||
((or "-d" "--debug")
|
||||
(setenv "DEBUG" "1")
|
||||
(message "Debug mode on"))
|
||||
((or "-i" "--insecure")
|
||||
(setenv "INSECURE" "1")
|
||||
(message "Insecure mode on"))
|
||||
((or "-p" "--private")
|
||||
(setq doom-private-dir (expand-file-name (concat (pop args) "/")))
|
||||
(setenv "DOOMDIR" doom-private-dir)
|
||||
(message "DOOMDIR changed to %s" doom-private-dir)
|
||||
(or (file-directory-p doom-private-dir)
|
||||
(message "Warning: %s does not exist"
|
||||
(abbreviate-file-name doom-private-dir))))
|
||||
((or "-l" "--local")
|
||||
(setq doom-local-dir (expand-file-name (concat (pop args) "/")))
|
||||
(setenv "DOOMLOCALDIR" doom-local-dir)
|
||||
(message "DOOMLOCALDIR changed to %s" doom-local-dir))
|
||||
((or "-e" "--emacsd")
|
||||
(setq user-emacs-directory (expand-file-name (concat (pop args) "/")))
|
||||
(message "Emacs directory changed to %s" user-emacs-directory))
|
||||
((or "-y" "--yes")
|
||||
(setenv "YES" "1")
|
||||
(message "Auto-yes mode on"))))
|
||||
(defcli! :main
|
||||
((help-p ["-h" "--help"] "Same as help command")
|
||||
(debug-p ["-d" "--debug"] "Turns on doom-debug-mode (and debug-on-error)")
|
||||
(yes-p ["-y" "--yes"] "Auto-accept all confirmation prompts")
|
||||
(emacsdir ["--emacsdir" dir] "Use the emacs config at DIR (e.g. ~/.emacs.d)")
|
||||
(doomdir ["--doomdir" dir] "Use the private module at DIR (e.g. ~/.doom.d)")
|
||||
(localdir ["--localdir" dir] "Use DIR as your local storage directory")
|
||||
&optional command &rest args)
|
||||
"A command line interface for managing Doom Emacs.
|
||||
|
||||
(unless (file-directory-p user-emacs-directory)
|
||||
(error "%s does not exist" user-emacs-directory))
|
||||
Includes package management, diagnostics, unit tests, and byte-compilation.
|
||||
|
||||
;; Bootstrap Doom
|
||||
(if (not noninteractive)
|
||||
(let ((doom-interactive-mode t))
|
||||
(load (expand-file-name "init.el" user-emacs-directory)
|
||||
nil 'nomessage)
|
||||
(doom-run-all-startup-hooks-h))
|
||||
(load (expand-file-name "core/core.el" user-emacs-directory)
|
||||
nil 'nomessage)
|
||||
(doom-initialize 'force-p)
|
||||
(doom-initialize-modules)
|
||||
This tool also makes it trivial to launch Emacs out of a different folder or
|
||||
with a different private module."
|
||||
:bare t
|
||||
(when emacsdir
|
||||
(setq user-emacs-directory (file-name-as-directory emacsdir))
|
||||
(print! (info "EMACSDIR=%s") localdir))
|
||||
(when doomdir
|
||||
(setenv "DOOMDIR" doomdir)
|
||||
(print! (info "DOOMDIR=%s") localdir))
|
||||
(when localdir
|
||||
(setenv "DOOMLOCALDIR" localdir)
|
||||
(print! (info "DOOMLOCALDIR=%s") localdir))
|
||||
(when debug-p
|
||||
(setenv "DEBUG" "1")
|
||||
(setq doom-debug-mode t)
|
||||
(print! (info "Debug mode on")))
|
||||
(when yes-p
|
||||
(setenv "YES" "1")
|
||||
(setq doom-auto-accept t)
|
||||
(print! (info "Auto-yes on")))
|
||||
(when help-p
|
||||
(push command args)
|
||||
(setq command "help"))
|
||||
|
||||
(cond ((or (not args)
|
||||
(and (not (cdr args))
|
||||
(member (car args) '("help" "h"))))
|
||||
(unless args
|
||||
(print! (error "No command detected.\n")))
|
||||
(usage))
|
||||
((require 'core-cli)
|
||||
(setq argv nil)
|
||||
(condition-case e
|
||||
(doom-dispatch (car args) (cdr args))
|
||||
;; Reload core in case any of the directories were changed.
|
||||
(when (or emacsdir doomdir localdir)
|
||||
(load! "core/core.el" user-emacs-directory))
|
||||
|
||||
(cond ((not noninteractive)
|
||||
(print! "Doom launched out of %s (test mode)" (path user-emacs-directory))
|
||||
(load! "init.el" user-emacs-directory)
|
||||
(doom-run-all-startup-hooks-h))
|
||||
|
||||
((null command)
|
||||
(doom-cli-execute "help"))
|
||||
|
||||
((condition-case e
|
||||
(let ((start-time (current-time)))
|
||||
(and (doom-cli-execute command args)
|
||||
(terpri)
|
||||
(print! (success "Finished! (%.4fs)")
|
||||
(float-time
|
||||
(time-subtract (current-time)
|
||||
start-time)))))
|
||||
(user-error
|
||||
(print! (error "%s\n") (error-message-string e))
|
||||
(print! (yellow "See 'doom help %s' for documentation on this command.") (car args)))
|
||||
|
|
@ -116,5 +90,8 @@
|
|||
"report, please include it!\n\n"
|
||||
"Emacs outputs to standard error, so you'll need to redirect stderr to\n"
|
||||
"stdout to pipe this to a file or clipboard!\n\n"
|
||||
" e.g. doom -d install 2>&1 | clipboard-program"))
|
||||
(signal 'doom-error e))))))))
|
||||
" e.g. doom -d install 2>&1 | clipboard-program\n"))
|
||||
(signal 'doom-error e)))))))
|
||||
|
||||
(doom-cli-execute :main (cdr (member "--" argv)))
|
||||
(setq argv nil))
|
||||
|
|
|
|||
257
bin/doom-doctor
257
bin/doom-doctor
|
|
@ -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!"))
|
||||
|
|
@ -124,89 +124,3 @@ Warning: freezes indefinitely on any stdin prompt."
|
|||
(sit-for 0.1))
|
||||
(process-exit-status process))
|
||||
(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))
|
||||
|
|
|
|||
|
|
@ -1,14 +1,11 @@
|
|||
;;; core/cli/autoloads.el -*- lexical-binding: t; -*-
|
||||
|
||||
(require 'autoload)
|
||||
|
||||
|
||||
(defvar doom-autoload-excluded-packages '("gh")
|
||||
"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
|
||||
one wants that.")
|
||||
|
||||
;; external variables
|
||||
;; externs
|
||||
(defvar autoload-timestamps)
|
||||
(defvar generated-autoload-load-name)
|
||||
(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',
|
||||
`package-activated-list' and `auto-mode-alist'."
|
||||
;; REVIEW Can we avoid calling `straight-check-all' everywhere?
|
||||
(straight-check-all)
|
||||
(doom-reload-autoloads nil 'force))
|
||||
(doom-cli-reload-autoloads nil 'force))
|
||||
|
||||
|
||||
;;
|
||||
;;; 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."
|
||||
(cl-check-type file string)
|
||||
(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)))
|
||||
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 " M-x doom/restart-and-restore")
|
||||
(message " M-x doom/restart")
|
||||
(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))
|
||||
(byte-compile-dynamic t)
|
||||
(byte-compile-dynamic-docstrings t))
|
||||
(condition-case-unless-debug e
|
||||
(when (byte-compile-file file)
|
||||
(prog1 (load file 'noerror 'nomessage)
|
||||
(prog1 (load file 'noerror 'nomessage 'nosuffix)
|
||||
(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)
|
||||
(let ((backup-file (concat file ".bk")))
|
||||
(print! (warn "Copied backup to %s") (relpath backup-file))
|
||||
(copy-file file backup-file 'overwrite))
|
||||
(doom-delete-autoloads-file file)
|
||||
(doom--cli-delete-autoloads-file file)
|
||||
(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.
|
||||
|
||||
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)))
|
||||
(if (stringp 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)
|
||||
(doom-reload-package-autoloads force-p))
|
||||
(doom-cli-reload-package-autoloads force-p))
|
||||
((error "Invalid autoloads file: %s" file)))
|
||||
(doom-reload-core-autoloads force-p)
|
||||
(doom-reload-package-autoloads force-p)))
|
||||
(doom-cli-reload-core-autoloads force-p)
|
||||
(doom-cli-reload-package-autoloads force-p)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Doom autoloads
|
||||
|
||||
(defun doom--generate-header (func)
|
||||
(defun doom--cli-generate-header (func)
|
||||
(goto-char (point-min))
|
||||
(insert ";; -*- lexical-binding:t; -*-\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))
|
||||
(dolist (file targets)
|
||||
(insert
|
||||
|
|
@ -115,7 +111,7 @@ even if it doesn't need reloading!"
|
|||
"Scanned %d file(s)")
|
||||
n)))
|
||||
|
||||
(defun doom--expand-autoload-paths (&optional allow-internal-paths)
|
||||
(defun doom--cli-expand-autoload-paths (&optional allow-internal-paths)
|
||||
(let ((load-path
|
||||
;; NOTE With `doom-private-dir' in `load-path', Doom autoloads files
|
||||
;; will be unable to declare autoloads for the built-in autoload.el
|
||||
|
|
@ -140,7 +136,7 @@ even if it doesn't need reloading!"
|
|||
path)
|
||||
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)
|
||||
(while (re-search-forward "^;;;###autodef *\\([^\n]+\\)?\n" nil t)
|
||||
(let* ((sexp (sexp-at-point))
|
||||
|
|
@ -202,7 +198,7 @@ even if it doesn't need reloading!"
|
|||
(member-p (push sexp forms)))))
|
||||
forms))
|
||||
|
||||
(defun doom--generate-autodefs (targets enabled-targets)
|
||||
(defun doom--cli-generate-autodefs (targets enabled-targets)
|
||||
(goto-char (point-max))
|
||||
(search-backward ";;;***" nil t)
|
||||
(save-excursion (insert "\n"))
|
||||
|
|
@ -210,17 +206,17 @@ even if it doesn't need reloading!"
|
|||
(insert
|
||||
(with-temp-buffer
|
||||
(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")
|
||||
"\n")
|
||||
"")))))
|
||||
|
||||
(defun doom--cleanup-autoloads ()
|
||||
(defun doom--cli-cleanup-autoloads ()
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward "^;;\\(;[^\n]*\\| no-byte-compile: t\\)\n" nil 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).
|
||||
|
||||
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'.
|
||||
|
||||
Run this whenever your `doom!' block, or a module autoload file, is modified."
|
||||
(require 'autoload)
|
||||
(let* ((default-directory doom-emacs-dir)
|
||||
(doom-modules (doom-modules))
|
||||
|
||||
|
|
@ -269,37 +266,38 @@ Run this whenever your `doom!' block, or a module autoload file, is modified."
|
|||
(ignore
|
||||
(print! (success "Skipping core autoloads, they are up-to-date"))
|
||||
(doom-load-autoloads-file doom-autoload-file))
|
||||
(print! (start "Regenerating core autoloads file"))
|
||||
|
||||
(if (doom-delete-autoloads-file doom-autoload-file)
|
||||
(if (doom--cli-delete-autoloads-file doom-autoload-file)
|
||||
(print! (success "Deleted old %s") (filename doom-autoload-file))
|
||||
(make-directory (file-name-directory doom-autoload-file) t))
|
||||
|
||||
(with-temp-file doom-autoload-file
|
||||
(doom--generate-header 'doom-reload-core-autoloads)
|
||||
(save-excursion
|
||||
(doom--generate-autoloads active-targets)
|
||||
(print! (success "Generated new autoloads.el")))
|
||||
;; Replace autoload paths (only for module autoloads) with absolute
|
||||
;; paths for faster resolution during load and simpler `load-path'
|
||||
(save-excursion
|
||||
(doom--expand-autoload-paths 'allow-internal-paths)
|
||||
(print! (success "Expanded module autoload paths")))
|
||||
;; Generates stub definitions for functions/macros defined in disabled
|
||||
;; modules, so that you will never get a void-function when you use
|
||||
;; them.
|
||||
(save-excursion
|
||||
(doom--generate-autodefs targets (reverse active-targets))
|
||||
(print! (success "Generated autodefs")))
|
||||
;; Remove byte-compile-inhibiting file variables so we can byte-compile
|
||||
;; the file, and autoload comments.
|
||||
(doom--cleanup-autoloads)
|
||||
(print! (success "Clean up autoloads")))
|
||||
(print! (start "Regenerating core autoloads file"))
|
||||
(print-group!
|
||||
(with-temp-file doom-autoload-file
|
||||
(doom--cli-generate-header 'doom-cli-reload-core-autoloads)
|
||||
(save-excursion
|
||||
(doom--cli-generate-autoloads active-targets)
|
||||
(print! (success "Generated new autoloads.el")))
|
||||
;; Replace autoload paths (only for module autoloads) with absolute
|
||||
;; paths for faster resolution during load and simpler `load-path'
|
||||
(save-excursion
|
||||
(doom--cli-expand-autoload-paths 'allow-internal-paths)
|
||||
(print! (success "Expanded module autoload paths")))
|
||||
;; Generates stub definitions for functions/macros defined in disabled
|
||||
;; modules, so that you will never get a void-function when you use
|
||||
;; them.
|
||||
(save-excursion
|
||||
(doom--cli-generate-autodefs targets (reverse active-targets))
|
||||
(print! (success "Generated autodefs")))
|
||||
;; Remove byte-compile-inhibiting file variables so we can byte-compile
|
||||
;; the file, and autoload comments.
|
||||
(doom--cli-cleanup-autoloads)
|
||||
(print! (success "Cleaned up autoloads"))))
|
||||
;; Byte compile it to give the file a chance to reveal errors (and buy us a
|
||||
;; few marginal performance boosts)
|
||||
(print! "> Byte-compiling %s..." (relpath doom-autoload-file))
|
||||
(when (doom--byte-compile-file doom-autoload-file)
|
||||
(print! (success "Finished compiling %s") (relpath doom-autoload-file))))
|
||||
(when (doom--cli-byte-compile-file doom-autoload-file)
|
||||
(print-group!
|
||||
(print! (success "Compiled %s") (relpath doom-autoload-file)))))
|
||||
t)))
|
||||
|
||||
|
||||
|
|
@ -346,7 +344,7 @@ served no purpose but to waste cycles."
|
|||
(goto-char (match-beginning 1))
|
||||
(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
|
||||
installed packages. It also caches `load-path', `Info-directory-list',
|
||||
`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.
|
||||
|
||||
This should be run whenever your `doom!' block or update your packages."
|
||||
(require 'autoload)
|
||||
(print! (start "Checking package autoloads file"))
|
||||
(print-group!
|
||||
(if (and (not force-p)
|
||||
|
|
@ -381,37 +380,39 @@ This should be run whenever your `doom!' block or update your packages."
|
|||
(version-control 'never)
|
||||
(case-fold-search nil) ; reduce magic
|
||||
(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))
|
||||
(make-directory (file-name-directory doom-autoload-file) t))
|
||||
|
||||
(with-temp-file doom-package-autoload-file
|
||||
(doom--generate-header 'doom-reload-package-autoloads)
|
||||
(print! (start "Regenerating package autoloads file"))
|
||||
(print-group!
|
||||
(with-temp-file doom-package-autoload-file
|
||||
(doom--cli-generate-header 'doom-cli-reload-package-autoloads)
|
||||
|
||||
(save-excursion
|
||||
;; Cache important and expensive-to-initialize state here.
|
||||
(doom--generate-var-cache)
|
||||
(print! (success "Cached package state"))
|
||||
;; Concatenate the autoloads of all installed packages.
|
||||
(doom--generate-package-autoloads)
|
||||
(print! (success "Package autoloads included")))
|
||||
(save-excursion
|
||||
;; Cache important and expensive-to-initialize state here.
|
||||
(doom--generate-var-cache)
|
||||
(print! (success "Cached package state"))
|
||||
;; Concatenate the autoloads of all installed packages.
|
||||
(doom--generate-package-autoloads)
|
||||
(print! (success "Package autoloads included")))
|
||||
|
||||
;; Replace autoload paths (only for module autoloads) with absolute
|
||||
;; paths for faster resolution during load and simpler `load-path'
|
||||
(save-excursion
|
||||
(doom--expand-autoload-paths)
|
||||
(print! (success "Expanded module autoload paths")))
|
||||
;; Replace autoload paths (only for module autoloads) with absolute
|
||||
;; paths for faster resolution during load and simpler `load-path'
|
||||
(save-excursion
|
||||
(doom--cli-expand-autoload-paths)
|
||||
(print! (success "Expanded module autoload paths")))
|
||||
|
||||
;; Remove `load-path' and `auto-mode-alist' modifications (most of them,
|
||||
;; at least); they are cached later, so all those membership checks are
|
||||
;; unnecessary overhead.
|
||||
(doom--cleanup-package-autoloads)
|
||||
(print! (success "Removed load-path/auto-mode-alist entries")))
|
||||
;; Remove `load-path' and `auto-mode-alist' modifications (most of them,
|
||||
;; at least); they are cached later, so all those membership checks are
|
||||
;; unnecessary overhead.
|
||||
(doom--cleanup-package-autoloads)
|
||||
(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
|
||||
;; few marginal performance boosts)
|
||||
(print! (start "Byte-compiling %s...") (relpath doom-package-autoload-file))
|
||||
(when (doom--byte-compile-file doom-package-autoload-file)
|
||||
(print! (success "Finished compiling %s") (relpath doom-package-autoload-file)))))
|
||||
(when (doom--cli-byte-compile-file doom-package-autoload-file)
|
||||
(print-group!
|
||||
(print! (success "Compiled %s") (relpath doom-package-autoload-file))))))
|
||||
t))
|
||||
|
|
|
|||
|
|
@ -1,6 +1,8 @@
|
|||
;;; 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.
|
||||
|
||||
compile [TARGETS...]
|
||||
|
|
@ -10,14 +12,11 @@
|
|||
Accepts :core and :private as special arguments, which target Doom's core files
|
||||
and your private config files, respectively. To recompile your packages, use
|
||||
'doom rebuild' instead."
|
||||
(doom-byte-compile targets))
|
||||
|
||||
(defcli! (recompile rc) (&rest targets)
|
||||
"Re-byte-compiles outdated *.elc files."
|
||||
(doom-byte-compile targets 'recompile))
|
||||
(doom-cli-byte-compile targets recompile-p))
|
||||
|
||||
(defcli! clean ()
|
||||
"Delete all *.elc files."
|
||||
:bare t
|
||||
(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"))
|
||||
(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.
|
||||
|
||||
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
|
||||
(doom-clean-byte-compiled-files))
|
||||
|
||||
(dolist (target (delete-dups targets))
|
||||
(dolist (target (delete-dups (delq nil targets)))
|
||||
(cl-incf
|
||||
(if (not (or (not recompile-p)
|
||||
(let ((elc-file (byte-compile-dest-file target)))
|
||||
|
|
|
|||
|
|
@ -1,21 +1,11 @@
|
|||
;;; core/cli/debug.el -*- lexical-binding: t; -*-
|
||||
|
||||
(load! "autoload/debug" doom-core-dir)
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! info (&optional format)
|
||||
"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."
|
||||
(defcli! info
|
||||
((format ["--json" "--md" "--lisp"] "What format to dump info into"))
|
||||
"Output system info in markdown for bug reports."
|
||||
(pcase format
|
||||
("--json"
|
||||
(require 'json)
|
||||
|
|
@ -23,7 +13,7 @@ If no arguments are given, --raw is assumed."
|
|||
(insert (json-encode (doom-info)))
|
||||
(json-pretty-print-buffer)
|
||||
(print! (buffer-string))))
|
||||
((or "--md" "--markdown")
|
||||
("--md"
|
||||
(doom/info))
|
||||
((or `nil "--lisp")
|
||||
(doom/info 'raw))
|
||||
|
|
@ -33,6 +23,7 @@ If no arguments are given, --raw is assumed."
|
|||
nil)
|
||||
|
||||
(defcli! (version v) ()
|
||||
"Reports the version of Doom and Emacs."
|
||||
"Show version information for Doom & Emacs."
|
||||
:bare t
|
||||
(doom/version)
|
||||
nil)
|
||||
|
|
|
|||
209
core/cli/doctor.el
Normal file
209
core/cli/doctor.el
Normal 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)
|
||||
145
core/cli/env.el
145
core/cli/env.el
|
|
@ -1,13 +1,15 @@
|
|||
;;; 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.
|
||||
|
||||
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
|
||||
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)
|
||||
|
|
@ -21,14 +23,23 @@ app launchers on Linux).
|
|||
This file is automatically regenerated when you run this command or 'doom
|
||||
refresh'. However, 'doom refresh' will only regenerate this file if it exists.
|
||||
|
||||
Use the -c or --clear switch to delete your envvar file."
|
||||
(when (member "clear" args) ; DEPRECATED
|
||||
(message "'doom env clear' is deprecated. Use 'doom env -c' or 'doom env --clear' instead")
|
||||
(push "-c" args))
|
||||
(let ((env-file (or (cadr (member "-o" args))
|
||||
doom-env-file)))
|
||||
(cond ((or (member "-c" args)
|
||||
(member "--clear" args))
|
||||
Why this over exec-path-from-shell?
|
||||
|
||||
1. `exec-path-from-shell' spawns (at least) one process at startup to scrape
|
||||
your shell environment. This can be arbitrarily slow depending on the
|
||||
user's shell configuration. A single program (like pyenv or nvm) or config
|
||||
framework (like oh-my-zsh) could undo all of Doom's startup optimizations
|
||||
in one fell swoop.
|
||||
|
||||
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)
|
||||
(user-error! "%S does not exist to be cleared"
|
||||
(path env-file)))
|
||||
|
|
@ -36,12 +47,11 @@ Use the -c or --clear switch to delete your envvar file."
|
|||
(print! (success "Successfully deleted %S")
|
||||
(path env-file)))
|
||||
|
||||
((or (null args)
|
||||
(member "-o" args))
|
||||
(doom-reload-env-file 'force env-file))
|
||||
(args
|
||||
(user-error "I don't understand 'doom env %s'"
|
||||
(string-join args " ")))
|
||||
|
||||
((user-error "I don't understand 'doom env %s'"
|
||||
(string-join args " "))))))
|
||||
((doom-cli-reload-env-file 'force env-file)))))
|
||||
|
||||
|
||||
;;
|
||||
|
|
@ -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
|
||||
`doom-env-file'.")
|
||||
|
||||
(defvar doom-env-executable
|
||||
(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)
|
||||
(defun doom-cli-reload-env-file (&optional force-p env-file)
|
||||
"Generates `doom-env-file', if it doesn't exist (or if FORCE-P).
|
||||
|
||||
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")
|
||||
(path env-file))
|
||||
(let ((process-environment doom--initial-process-environment))
|
||||
(let ((shell-command-switch doom-env-switches)
|
||||
(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!
|
||||
(let ((errors (with-current-buffer error-buffer (buffer-string))))
|
||||
(unless (string-empty-p errors)
|
||||
(print! (info "Warnings:\n\n%s") (indent 4 errors))))
|
||||
;; Remove undesireable variables
|
||||
(insert
|
||||
(concat
|
||||
"# -*- mode: dotenv -*-\n"
|
||||
(format "# Generated with: %s %s %s\n"
|
||||
shell-file-name
|
||||
doom-env-switches
|
||||
doom-env-executable)
|
||||
"# ---------------------------------------------------------------------------\n"
|
||||
"# This file was auto-generated by `doom env'. It contains a list of environment\n"
|
||||
"# variables scraped from your default shell (excluding variables blacklisted\n"
|
||||
"# in doom-env-ignored-vars).\n"
|
||||
"#\n"
|
||||
"# It is NOT safe to edit this file. Changes will be overwritten next time that\n"
|
||||
"# `doom refresh` is executed. Alternatively, create your own env file with\n"
|
||||
"# `doom env -o ~/.doom.d/myenv`, then load it with (doom-load-envvars-file FILE)\n"
|
||||
"# in your private config.el.\n"
|
||||
"# ---------------------------------------------------------------------------\n\n"))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "\n\\([^= \n]+\\)=" nil t)
|
||||
(save-excursion
|
||||
(let* ((valend (or (save-match-data
|
||||
(when (re-search-forward "^\\([^= ]+\\)=" nil t)
|
||||
(line-beginning-position)))
|
||||
(point-max)))
|
||||
(var (match-string 1)))
|
||||
(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")
|
||||
(path env-file))
|
||||
t))))))
|
||||
(print! (info "Scraping shell environment"))
|
||||
(print-group!
|
||||
(when doom-interactive-mode
|
||||
(user-error "'doom env' must be run on the command line, not an interactive session"))
|
||||
(goto-char (point-min))
|
||||
(insert
|
||||
(concat
|
||||
"# -*- mode: dotenv -*-\n"
|
||||
(format "# Generated from a %s shell environent\n" shell-file-name)
|
||||
"# ---------------------------------------------------------------------------\n"
|
||||
"# This file was auto-generated by `doom env'. It contains a list of environment\n"
|
||||
"# variables scraped from your default shell (excluding variables blacklisted\n"
|
||||
"# in doom-env-ignored-vars).\n"
|
||||
"#\n"
|
||||
(if (file-equal-p env-file doom-env-file)
|
||||
(concat "# It is NOT safe to edit this file. Changes will be overwritten next time you\n"
|
||||
"# run 'doom refresh'. To create a safe-to-edit envvar file use:\n#\n"
|
||||
"# doom env -o ~/.doom.d/myenv\n#\n"
|
||||
"# And load it with (doom-load-envvars-file \"~/.doom.d/myenv\").\n")
|
||||
(concat "# This file is safe to edit by hand, but needs to be loaded manually with:\n#\n"
|
||||
"# (doom-load-envvars-file \"path/to/this/file\")\n#\n"
|
||||
"# Use 'doom env -o path/to/this/file' to regenerate it."))
|
||||
"# ---------------------------------------------------------------------------\n\n"))
|
||||
;; We assume that this noninteractive session was spawned from the
|
||||
;; user's interactive shell, therefore we just dump
|
||||
;; `process-environment' to a file.
|
||||
(dolist (env process-environment)
|
||||
(if (cl-find-if (doom-rpartial #'string-match-p env)
|
||||
doom-env-ignored-vars)
|
||||
(print! (info "Ignoring %s") env)
|
||||
(insert env "\n")))
|
||||
(print! (success "Successfully generated %S")
|
||||
(path env-file))
|
||||
t))))))
|
||||
|
|
|
|||
101
core/cli/help.el
Normal file
101
core/cli/help.el
Normal 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)))))
|
||||
|
|
@ -1,13 +1,11 @@
|
|||
;;; core/cli/install.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defcli! quickstart (&rest args) ; DEPRECATED
|
||||
"This is a deprecated alias for 'doom install'.
|
||||
|
||||
See 'doom help install' instead."
|
||||
:hidden t
|
||||
(apply #'doom-cli-install args))
|
||||
|
||||
(defcli! (install i) (&rest args)
|
||||
(defcli! (install i)
|
||||
((noconfig-p ["--no-config"] "Don't create DOOMDIR or dummy files therein")
|
||||
(noenv-p ["--no-env"] "Don't generate an envvars file (see 'doom help env')")
|
||||
(noinstall-p ["--no-install"] "Don't auto-install packages")
|
||||
(nofonts-p ["--no-fonts"] "Don't install (or prompt to install) all-the-icons fonts")
|
||||
&rest args)
|
||||
"Installs and sets up Doom Emacs for the first time.
|
||||
|
||||
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.
|
||||
|
||||
doom -p ~/.config/doom install
|
||||
DOOMDIR=~/.config/doom doom install
|
||||
|
||||
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"
|
||||
DOOMDIR=~/.config/doom doom install"
|
||||
:bare t
|
||||
(print! (green "Installing Doom Emacs!\n"))
|
||||
(let ((default-directory (doom-path "~")))
|
||||
;; Create `doom-private-dir'
|
||||
(if (member "--no-config" args)
|
||||
(if noconfig-p
|
||||
(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)
|
||||
(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
|
||||
(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
|
||||
;; 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
|
||||
(if (member "--no-env" args)
|
||||
(print! (warn "- Not generating envvars file, as requested"))
|
||||
(when (or doom-auto-accept
|
||||
(y-or-n-p "Generate an env file? (see `doom help env` for details)"))
|
||||
(doom-reload-env-file 'force-p)))
|
||||
;; Ask if user would like an envvar file generated
|
||||
(if noenv-p
|
||||
(print! (warn "Not generating envvars file, as requested"))
|
||||
(if (file-exists-p doom-env-file)
|
||||
(print! (info "Envvar file already exists, skipping"))
|
||||
(when (or doom-auto-accept
|
||||
(y-or-n-p "Generate an env file? (see `doom help env` for details)"))
|
||||
(doom-cli-reload-env-file 'force-p))))
|
||||
|
||||
;; Install Doom packages
|
||||
(if (member "--no-install" args)
|
||||
(print! (warn "- Not installing plugins, as requested"))
|
||||
(if noinstall-p
|
||||
(print! (warn "Not installing plugins, as requested"))
|
||||
(print! "Installing plugins")
|
||||
(doom-packages-install doom-auto-accept))
|
||||
(doom-cli-packages-install doom-auto-accept))
|
||||
|
||||
(print! "Regenerating autoloads files")
|
||||
(doom-reload-autoloads nil 'force-p)
|
||||
|
||||
(if (member "--no-fonts" args)
|
||||
(print! (warn "- Not installing fonts, as requested"))
|
||||
(if nofonts-p
|
||||
(print! (warn "Not installing fonts, as requested"))
|
||||
(when (or doom-auto-accept
|
||||
(y-or-n-p "Download and install all-the-icon's fonts?"))
|
||||
(require 'all-the-icons)
|
||||
|
|
@ -98,6 +93,9 @@ The following switches are recognized:
|
|||
(IS-LINUX 'x))))
|
||||
(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"))
|
||||
(with-temp-buffer
|
||||
(doom-template-insert "QUICKSTART_INTRO")
|
||||
|
|
|
|||
|
|
@ -1,73 +1,55 @@
|
|||
;; -*- no-byte-compile: t; -*-
|
||||
;;; core/cli/packages.el
|
||||
|
||||
(defmacro doom--ensure-autoloads-while (&rest body)
|
||||
`(progn
|
||||
(straight-check-all)
|
||||
(doom-reload-core-autoloads)
|
||||
(when (progn ,@body)
|
||||
(doom-reload-package-autoloads 'force-p))
|
||||
t))
|
||||
|
||||
|
||||
;;
|
||||
;;; Dispatchers
|
||||
|
||||
(defcli! (update u) (&rest args)
|
||||
(defcli! (update u) ()
|
||||
"Updates packages.
|
||||
|
||||
This works by fetching all installed package repos and checking the distance
|
||||
between HEAD and FETCH_HEAD. This can take a while.
|
||||
|
||||
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:
|
||||
-t/--timeout TTL Seconds until a thread is timed out (default: 45)
|
||||
--threads N How many threads to use (default: 8)"
|
||||
(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.
|
||||
(defcli! (build b)
|
||||
((rebuild-p ["-r"] "Only rebuild packages that need rebuilding"))
|
||||
"Byte-compiles & symlinks installed packages.
|
||||
|
||||
This ensures that all needed files are symlinked from their package repo and
|
||||
their elisp files are byte-compiled.
|
||||
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:
|
||||
-f Forcibly rebuild autoloads files, even if they're up-to-date"
|
||||
(doom--ensure-autoloads-while
|
||||
(doom-packages-rebuild doom-auto-accept (member "-f" args))))
|
||||
(defcli! (purge p)
|
||||
((nobuilds-p ["-b" "--no-builds"] "Don't purge unneeded (built) packages")
|
||||
(noelpa-p ["-p" "--no-elpa"] "Don't purge ELPA packages")
|
||||
(norepos-p ["-r" "--no-repos"] "Don't purge unused straight repos")
|
||||
(regraft-p ["-g" "--regraft"] "Regraft git repos (ie. compact them)"))
|
||||
"Deletes orphaned packages & repos, and compacts them.
|
||||
|
||||
(defcli! (purge p) (&rest args)
|
||||
"Deletes any unused ELPA packages, straight builds, and (optionally) repos.
|
||||
Purges all installed ELPA packages (as they are considered temporary). Purges
|
||||
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
|
||||
'doom purge --all' once in a while, to stymy build-up of repos and ELPA
|
||||
packages that could be taking up precious space.
|
||||
It is a good idea to occasionally run this doom purge -g to ensure your package
|
||||
list remains lean."
|
||||
(straight-check-all)
|
||||
(when (doom-cli-packages-purge
|
||||
(not noelpa-p)
|
||||
(not norepos-p)
|
||||
(not nobuilds-p)
|
||||
regraft-p)
|
||||
(doom-cli-reload-package-autoloads 'force-p))
|
||||
t)
|
||||
|
||||
Switches:
|
||||
--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
|
||||
;; (defcli! rollback () ; TODO doom rollback
|
||||
;; "<Not implemented yet>"
|
||||
;; (user-error "Not implemented yet, sorry!"))
|
||||
|
||||
|
|
@ -75,15 +57,12 @@ Switches:
|
|||
;;
|
||||
;;; Library
|
||||
|
||||
(defun doom-packages-install (&optional auto-accept-p)
|
||||
(defun doom-cli-packages-install ()
|
||||
"Installs missing packages.
|
||||
|
||||
This function will install any primary package (i.e. a package with a `package!'
|
||||
declaration) or dependency thereof that hasn't already been.
|
||||
|
||||
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...")
|
||||
declaration) or dependency thereof that hasn't already been."
|
||||
(print! (start "Installing & building packages..."))
|
||||
(print-group!
|
||||
(let ((n 0))
|
||||
(dolist (package (hash-table-keys straight--recipe-cache))
|
||||
|
|
@ -91,7 +70,7 @@ a list of packages that will be installed."
|
|||
(local-repo)
|
||||
(let ((existed-p (file-directory-p (straight--repos-dir package))))
|
||||
(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)
|
||||
(file-directory-p (straight--repos-dir package))
|
||||
(cl-incf n))
|
||||
|
|
@ -104,17 +83,18 @@ a list of packages that will be installed."
|
|||
t))))
|
||||
|
||||
|
||||
(defun doom-packages-rebuild (&optional auto-accept-p all)
|
||||
(defun doom-cli-packages-build (&optional force-p)
|
||||
"(Re)build all packages."
|
||||
(print! (start "(Re)building %spackages...") (if all "all " ""))
|
||||
(print! (start "(Re)building %spackages...") (if force-p "all " ""))
|
||||
(print-group!
|
||||
(let ((n 0))
|
||||
(if all
|
||||
(if force-p
|
||||
(let ((straight--packages-to-rebuild :all)
|
||||
(straight--packages-not-to-rebuild (make-hash-table :test #'equal)))
|
||||
(dolist (package (hash-table-keys straight--recipe-cache))
|
||||
(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))
|
||||
(straight--with-plist recipe (package local-repo no-build)
|
||||
(unless (or no-build (null local-repo))
|
||||
|
|
@ -139,7 +119,9 @@ a list of packages that will be installed."
|
|||
(lambda (&rest _) (cl-incf n)))
|
||||
(let ((straight--packages-to-rebuild :all)
|
||||
(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)
|
||||
(dolist (dep (straight--get-dependencies package))
|
||||
(when-let (recipe (gethash dep straight--recipe-cache))
|
||||
|
|
@ -151,268 +133,107 @@ a list of packages that will be installed."
|
|||
t))))
|
||||
|
||||
|
||||
(defun doom--packages-remove-outdated-f (packages)
|
||||
(async-start
|
||||
`(lambda ()
|
||||
(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))
|
||||
(straight--packages-not-to-rebuild (make-hash-table :test #'equal)))
|
||||
(dolist (spec specs)
|
||||
(cl-destructuring-bind (n pretime time recipe) spec
|
||||
(straight--with-plist recipe (local-repo package)
|
||||
(let ((default-directory (straight--repos-dir local-repo)))
|
||||
(print! (start "Updating %S") package)
|
||||
(straight-merge-package package)
|
||||
;; HACK `straight-rebuild-package' doesn't pick up that
|
||||
;; this package has changed, so we do it manually. Is
|
||||
;; there a better way?
|
||||
(ignore-errors
|
||||
(delete-directory (straight--build-dir package) 'recursive))
|
||||
(puthash package t straight--packages-to-rebuild)
|
||||
(cl-incf n))
|
||||
(with-current-buffer (straight--process-get-buffer)
|
||||
(with-silent-modifications
|
||||
(print! (debug (autofill "%s") (indent 2 (buffer-string))))
|
||||
(erase-buffer))))))
|
||||
(doom--finalize-straight)
|
||||
(doom-packages-rebuild auto-accept-p))
|
||||
t)
|
||||
(print! (success "No packages to update"))
|
||||
nil))
|
||||
(error
|
||||
(message "Output:\n%s" (straight--process-get-output))
|
||||
(signal (car e) (error-message-string e)))))))
|
||||
(defun doom-cli-packages-update ()
|
||||
"Updates packages."
|
||||
(print! (start "Updating packages (this may take a while)..."))
|
||||
(let ((straight--packages-to-rebuild (make-hash-table :test #'equal))
|
||||
(total (hash-table-count straight--repo-cache))
|
||||
(i 1)
|
||||
errors)
|
||||
(print-group!
|
||||
(dolist (recipe (hash-table-values straight--repo-cache))
|
||||
(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)
|
||||
(let ((newcommit (straight-vc-get-commit type local-repo)))
|
||||
(if (string= commit newcommit)
|
||||
(print! (info "(%d/%d) %s is up-to-date") i total package)
|
||||
(ignore-errors
|
||||
(delete-directory (straight--build-dir package) 'recursive))
|
||||
(puthash package t straight--packages-to-rebuild)
|
||||
(print! (success "(%d/%d) %s updated (%s -> %s)") i total package
|
||||
(substring commit 0 7)
|
||||
(substring newcommit 0 7))
|
||||
(unless (string-empty-p output)
|
||||
(print-group!
|
||||
(print! (info "%s") output)
|
||||
(when (eq type 'git)
|
||||
(straight--call "git" "log" "--oneline" newcommit (concat "^" commit))
|
||||
(print-group!
|
||||
(print! "%s" (straight--process-get-output))))))))))
|
||||
(cl-incf i))
|
||||
(user-error
|
||||
(signal 'user-error (error-message-string e)))
|
||||
(error
|
||||
(print! (warn "(%d/%d) Encountered error with %s" i total package))
|
||||
(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)
|
||||
(defun doom--prompt-p (list-fn list preamble postamble)
|
||||
(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)
|
||||
(defun doom--cli-packages-purge-build (build)
|
||||
(let ((build-dir (straight--build-dir build)))
|
||||
(print! (start "Purging build/%s..." build))
|
||||
(delete-directory build-dir 'recursive)
|
||||
(if (file-directory-p build-dir)
|
||||
(ignore (print! (error "Failed to purg build/%s" build)))
|
||||
(print! (success "Purged build/%s" build))
|
||||
t)))
|
||||
|
||||
(defun doom--packages-purge-builds (builds &optional auto-accept-p)
|
||||
(defun doom--cli-packages-purge-builds (builds)
|
||||
(if (not builds)
|
||||
(progn (print! (info "No builds to purge"))
|
||||
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
|
||||
(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)))
|
||||
(if (not (file-directory-p ".git"))
|
||||
(ignore (print! (warn "repos/%s is not a git repo, skipping" repo)))
|
||||
(print! (debug "Regrafting repos/%s..." repo))
|
||||
(straight--call "git" "reset" "--hard")
|
||||
(straight--call "git" "clean" "--ffd")
|
||||
(straight--call "git" "replace" "--graft" "HEAD")
|
||||
(straight--call "git" "gc")
|
||||
(print! (debug "%s" (straight--process-get-output)))
|
||||
(print! (success "Regrafted repos/%s" repo))
|
||||
(let ((before-size (doom-directory-size default-directory)))
|
||||
(straight--call "git" "reset" "--hard")
|
||||
(straight--call "git" "clean" "-ffd")
|
||||
(if (not (car (straight--call "git" "replace" "--graft" "HEAD")))
|
||||
(print! (info "repos/%s is already compact" repo))
|
||||
(straight--call "git" "gc")
|
||||
(print! (success "Regrafted repos/%s (from %0.1fKB to %0.1fKB)")
|
||||
repo before-size (doom-directory-size default-directory))
|
||||
(print-group! (print! "%s" (straight--process-get-output)))))
|
||||
t)))
|
||||
|
||||
(defun doom--packages-regraft-repos (repos &optional auto-accept-p)
|
||||
(defun doom--cli-packages-regraft-repos (repos)
|
||||
(if (not repos)
|
||||
(progn (print! (info "No repos to regraft"))
|
||||
0)
|
||||
(or auto-accept-p
|
||||
(y-or-n-p (format! "Preparing to regraft all %d repos. Continue?"
|
||||
(length repos)))
|
||||
(user-error! "Aborted!"))
|
||||
(if (executable-find "du")
|
||||
(cl-destructuring-bind (status . 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)))))
|
||||
(let ((before-size (doom-directory-size (straight--repos-dir))))
|
||||
(prog1 (print-group! (delq nil (mapcar #'doom--cli-packages-regraft-repo repos)))
|
||||
(let ((after-size (doom-directory-size (straight--repos-dir))))
|
||||
(print! (success "Finished regrafting. Size before: %0.1fKB and after: %0.1fKB (-%0.1fKB)")
|
||||
before-size after-size
|
||||
(- after-size before-size)))))))
|
||||
|
||||
(defun doom--packages-purge-repo (repo)
|
||||
(print! (debug "Purging repos/%s..." repo))
|
||||
(defun doom--cli-packages-purge-repo (repo)
|
||||
(let ((repo-dir (straight--repos-dir repo)))
|
||||
(delete-directory repo-dir 'recursive)
|
||||
(ignore-errors
|
||||
|
|
@ -422,19 +243,14 @@ a list of packages that will be updated."
|
|||
(print! (success "Purged repos/%s" repo))
|
||||
t)))
|
||||
|
||||
(defun doom--packages-purge-repos (repos &optional auto-accept-p)
|
||||
(defun doom--cli-packages-purge-repos (repos)
|
||||
(if (not repos)
|
||||
(progn (print! (info "No repos to purge"))
|
||||
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
|
||||
(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)
|
||||
(package-initialize))
|
||||
(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)
|
||||
(progn (print! (info "No ELPA packages to purge"))
|
||||
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)
|
||||
(mapcar #'cdr 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.
|
||||
|
||||
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 REPOS-P, include straight repos.
|
||||
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."
|
||||
If ELPA-P, include packages installed with package.el (M-x package-install)."
|
||||
(print! (start "Searching for orphaned packages to purge (for the emperor)..."))
|
||||
(cl-destructuring-bind (&optional builds-to-purge repos-to-purge repos-to-regraft)
|
||||
(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!
|
||||
(if (not builds-p)
|
||||
(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)
|
||||
(straight-prune-build-cache)))
|
||||
(if (not elpa-p)
|
||||
(print! (info "Skipping elpa packages"))
|
||||
(and (/= 0 (doom--packages-purge-elpa auto-accept-p))
|
||||
(and (/= 0 (doom--cli-packages-purge-elpa))
|
||||
(setq success t)))
|
||||
(if (not repos-p)
|
||||
(print! (info "Skipping repos"))
|
||||
(and (/= 0 (doom--packages-purge-repos repos-to-purge auto-accept-p))
|
||||
(setq success t))
|
||||
(and (doom--packages-regraft-repos repos-to-regraft auto-accept-p)
|
||||
(and (/= 0 (doom--cli-packages-purge-repos repos-to-purge))
|
||||
(setq success t)))
|
||||
(if (not regraft-repos-p)
|
||||
(print! (info "Skipping regrafting"))
|
||||
(and (doom--cli-packages-regraft-repos repos-to-regraft)
|
||||
(setq success t)))
|
||||
(when success
|
||||
(doom--finalize-straight)
|
||||
|
|
|
|||
115
core/cli/test.el
115
core/cli/test.el
|
|
@ -7,9 +7,13 @@
|
|||
runemacs-binary-path
|
||||
emacs-binary-path)))
|
||||
|
||||
|
||||
(defcli! test (&rest targets)
|
||||
"Run Doom unit tests."
|
||||
(let (files error)
|
||||
:bare t
|
||||
(doom-initialize 'force)
|
||||
(require 'ansi-color)
|
||||
(let (files error read-files)
|
||||
(unless targets
|
||||
(setq targets
|
||||
(cons doom-core-dir
|
||||
|
|
@ -17,7 +21,7 @@
|
|||
(lambda (path) (file-in-directory-p path doom-emacs-dir))
|
||||
;; Omit `doom-private-dir', which is always first
|
||||
(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)))))))
|
||||
(while targets
|
||||
(let ((target (pop targets)))
|
||||
|
|
@ -31,45 +35,70 @@
|
|||
(push target files)))))
|
||||
(with-temp-buffer
|
||||
(print! (start "Bootstrapping test environment, if necessary..."))
|
||||
(if (zerop
|
||||
(call-process
|
||||
(doom--emacs-binary)
|
||||
nil t nil "--batch"
|
||||
"--eval" (prin1-to-string
|
||||
`(progn
|
||||
(setq doom-emacs-dir ,doom-emacs-dir
|
||||
doom-local-dir ,(concat doom-local-dir "test/")
|
||||
doom-private-dir ,(concat doom-core-dir "test/"))
|
||||
(require 'core ,(locate-library "core"))
|
||||
(doom-initialize 'force)
|
||||
(doom-initialize-modules)
|
||||
(require 'core-cli)
|
||||
(doom-reload-core-autoloads 'force)
|
||||
(when (doom-packages-install 'auto-accept)
|
||||
(doom-reload-package-autoloads 'force))))))
|
||||
(message "%s" (buffer-string))
|
||||
(message "%s" (buffer-string))
|
||||
(error "Failed to bootstrap unit tests")))
|
||||
(dolist (file files)
|
||||
(if (doom-file-cookie-p file "if" t)
|
||||
(with-temp-buffer
|
||||
(unless
|
||||
(zerop
|
||||
(apply #'call-process
|
||||
(doom--emacs-binary)
|
||||
nil t nil "--batch"
|
||||
(append (list
|
||||
"-L" doom-core-dir
|
||||
"-l" "core"
|
||||
"-l" (concat doom-core-dir "test/helpers.el"))
|
||||
(when (file-in-directory-p file doom-modules-dir)
|
||||
(list "-f" "doom-initialize-core"))
|
||||
(list
|
||||
"-l" file
|
||||
"-f" "buttercup-run"))))
|
||||
(setq error t))
|
||||
(message "%s" (buffer-string)))
|
||||
(print! (info "Ignoring %s" (relpath file)))))
|
||||
(if error
|
||||
(user-error "A test failed")
|
||||
(cl-destructuring-bind (status . output)
|
||||
(doom-exec-process
|
||||
(doom--emacs-binary)
|
||||
"--batch"
|
||||
"--eval"
|
||||
(prin1-to-string
|
||||
`(progn
|
||||
(setq doom-emacs-dir ,doom-emacs-dir
|
||||
doom-local-dir ,(concat doom-local-dir "test/")
|
||||
doom-private-dir ,(concat doom-core-dir "test/")
|
||||
doom-auto-accept t)
|
||||
(require 'core ,(locate-library "core"))
|
||||
(require 'core-cli)
|
||||
(doom-initialize 'force)
|
||||
(doom-initialize-modules)
|
||||
(doom-cli-reload-core-autoloads 'force)
|
||||
(when (doom-cli-packages-install)
|
||||
(doom-cli-reload-package-autoloads 'force)))))
|
||||
(unless (zerop status)
|
||||
(error "Failed to bootstrap unit tests"))))
|
||||
(with-temp-buffer
|
||||
(dolist (file files)
|
||||
(if (doom-file-cookie-p file "if" t)
|
||||
(cl-destructuring-bind (_status . output)
|
||||
(apply #'doom-exec-process
|
||||
(doom--emacs-binary)
|
||||
"--batch"
|
||||
"-l" (concat doom-core-dir "core.el")
|
||||
"-l" (concat doom-core-dir "test/helpers.el")
|
||||
(append (when (file-in-directory-p file doom-modules-dir)
|
||||
(list "-f" "doom-initialize-core"))
|
||||
(list "-l" file
|
||||
"-f" "buttercup-run")))
|
||||
(insert (replace-regexp-in-string ansi-color-control-seq-regexp "" output))
|
||||
(push file read-files))
|
||||
(print! (info "Ignoring %s" (relpath file)))))
|
||||
(let ((total 0)
|
||||
(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)))
|
||||
|
|
|
|||
|
|
@ -1,6 +1,8 @@
|
|||
;;; 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.
|
||||
|
||||
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
|
||||
bin/doom clean
|
||||
bin/doom refresh
|
||||
bin/doom update
|
||||
|
||||
Switches:
|
||||
-t/--timeout TTL Seconds until a thread is timed out (default: 45)
|
||||
--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)))
|
||||
bin/doom update"
|
||||
(and (doom-cli-upgrade doom-auto-accept force-p)
|
||||
(doom-cli-packages-update)
|
||||
(doom-cli-reload-package-autoloads 'force-p)))
|
||||
|
||||
|
||||
;;
|
||||
|
|
@ -44,7 +34,7 @@ Switches:
|
|||
(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."
|
||||
(require 'vc-git)
|
||||
(let ((default-directory doom-emacs-dir)
|
||||
|
|
@ -110,9 +100,8 @@ Switches:
|
|||
(equal (vc-git--rev-parse "HEAD") new-rev))
|
||||
(error "Failed to check out %s" (substring new-rev 0 10)))
|
||||
(print! (success "Finished upgrading Doom Emacs")))
|
||||
(doom-delete-autoloads-file doom-autoload-file)
|
||||
(doom-delete-autoloads-file doom-package-autoload-file)
|
||||
(doom-cli-refresh "-f")
|
||||
(doom-cli-execute "refresh" (append (if auto-accept-p '("-y")) '("-f")))
|
||||
(doom-cli-execute "update" (if auto-accept-p '("-y")))
|
||||
t)
|
||||
|
||||
(print! (success "Done! Restart Emacs for changes to take effect."))))))
|
||||
|
|
|
|||
342
core/core-cli.el
342
core/core-cli.el
|
|
@ -1,156 +1,219 @@
|
|||
;;; -*- 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")
|
||||
"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'.")
|
||||
|
||||
(defvar doom-cli-pre-execute-hook nil
|
||||
"TODO")
|
||||
(defvar doom-cli-post-success-execute-hook nil
|
||||
"TODO")
|
||||
|
||||
(defvar doom--cli-p nil)
|
||||
(defvar doom--cli-commands (make-hash-table :test 'equal))
|
||||
(defvar doom--cli-groups (make-hash-table :test 'equal))
|
||||
(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!"))))
|
||||
|
||||
;;
|
||||
;;; Dispatcher API
|
||||
(cl-defstruct doom-cli-option
|
||||
(symbol)
|
||||
(flags ())
|
||||
(args ())
|
||||
(desc "TODO"))
|
||||
|
||||
(defun doom-sh (command &rest args)
|
||||
"Execute COMMAND with ARGS in the shell and return (STATUS . OUTPUT).
|
||||
(defun doom--cli-get-option (cli flag)
|
||||
(cl-find-if (doom-partial #'member flag)
|
||||
(doom-cli-optlist cli)
|
||||
:key #'doom-cli-option-flags))
|
||||
|
||||
STATUS is a boolean"
|
||||
(let ((output (get-buffer-create "*doom-sh-output*")))
|
||||
(unwind-protect
|
||||
(cons (or (apply #'call-process command nil output nil args)
|
||||
-1)
|
||||
(with-current-buffer output
|
||||
(string-trim (buffer-string))))
|
||||
(kill-buffer output))))
|
||||
(defun doom--cli-process (cli args)
|
||||
(let* ((args (copy-sequence args))
|
||||
(arglist (copy-sequence (doom-cli-arglist cli)))
|
||||
(expected (or (cl-position-if (doom-rpartial #'memq cl--lambda-list-keywords)
|
||||
arglist)
|
||||
(length arglist)))
|
||||
(got 0)
|
||||
restvar
|
||||
rest
|
||||
alist)
|
||||
(catch 'done
|
||||
(while args
|
||||
(let ((arg (pop args)))
|
||||
(cond ((eq (car arglist) '&rest)
|
||||
(setq restvar (cadr arglist)
|
||||
rest (cons arg args))
|
||||
(throw 'done t))
|
||||
|
||||
(defun doom--dispatch-command (command)
|
||||
(when (symbolp command)
|
||||
(setq command (symbol-name command)))
|
||||
(cl-check-type command string)
|
||||
(intern-soft
|
||||
(format "doom-cli-%s"
|
||||
(if (gethash command doom--cli-commands)
|
||||
command
|
||||
(cl-loop for key
|
||||
being the hash-keys in doom--cli-commands
|
||||
for aliases = (plist-get (gethash key doom--cli-commands) :aliases)
|
||||
if (member command aliases)
|
||||
return key)))))
|
||||
((string-match "^\\(--\\([a-zA-Z0-9][a-zA-Z0-9-_]*\\)\\)\\(?:=\\(.+\\)\\)?$" arg)
|
||||
(let* ((fullflag (match-string 1 arg))
|
||||
(opt (doom--cli-get-option cli fullflag)))
|
||||
(unless opt
|
||||
(user-error "Unrecognized switch %S" (concat "--" (match-string 2 arg))))
|
||||
(map-put
|
||||
alist (doom-cli-option-symbol opt)
|
||||
(or (if (doom-cli-option-args opt)
|
||||
(or (match-string 3 arg)
|
||||
(pop args)
|
||||
(user-error "%S expected an argument, but got none"
|
||||
fullflag))
|
||||
(if (match-string 3 arg)
|
||||
(user-error "%S was not expecting an argument, but got %S"
|
||||
fullflag (match-string 3 arg))
|
||||
fullflag))))))
|
||||
|
||||
(defun doom--dispatch-format (desc &optional short)
|
||||
(with-temp-buffer
|
||||
(let ((fill-column 72))
|
||||
(save-excursion
|
||||
(insert desc)
|
||||
(while (re-search-backward "\n\n[^ \n]" nil t)
|
||||
(fill-paragraph))))
|
||||
(if (not short)
|
||||
(buffer-string)
|
||||
(buffer-substring (line-beginning-position)
|
||||
(line-end-position)))))
|
||||
((string-match "^\\(-\\([a-zA-Z0-9]+\\)\\)$" arg)
|
||||
(let ((fullflag (match-string 1 arg))
|
||||
(flag (match-string 2 arg)))
|
||||
(dolist (switch (split-string flag "" t))
|
||||
(if-let (opt (doom--cli-get-option cli (concat "-" switch)))
|
||||
(map-put
|
||||
alist (doom-cli-option-symbol opt)
|
||||
(if (doom-cli-option-args opt)
|
||||
(or (pop args)
|
||||
(user-error "%S expected an argument, but got none"
|
||||
fullflag))
|
||||
fullflag))
|
||||
(user-error "Unrecognized switch %S" (concat "-" switch))))))
|
||||
|
||||
(defun doom--dispatch-help-1 (command)
|
||||
(cl-destructuring-bind (&key aliases hidden _group)
|
||||
(gethash command doom--cli-commands)
|
||||
(unless hidden
|
||||
(print! "%-11s\t%s\t%s"
|
||||
command (if aliases (string-join aliases ",") "")
|
||||
(doom--dispatch-format
|
||||
(documentation (doom--dispatch-command command))
|
||||
t)))))
|
||||
(arglist
|
||||
(cl-incf got)
|
||||
(let ((spec (pop arglist)))
|
||||
(when (eq spec '&optional)
|
||||
(setq spec (pop arglist)))
|
||||
(map-put alist spec arg))
|
||||
(when (null arglist)
|
||||
(throw 'done t)))
|
||||
|
||||
(defun doom--dispatch-help (&optional fn &rest args)
|
||||
"Display help documentation for a dispatcher command. If fn and DESC are
|
||||
omitted, show all available commands, their aliases and brief descriptions."
|
||||
(if fn
|
||||
(princ (documentation fn))
|
||||
(print! (bold "%-11s\t%s\t%s" "Command:" "Alias" "Description"))
|
||||
(print-group!
|
||||
(dolist (group (seq-group-by (lambda (key) (plist-get (gethash key doom--cli-commands) :group))
|
||||
(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)))))
|
||||
(t
|
||||
(push arg args)
|
||||
(throw 'done t))))))
|
||||
(when (< got expected)
|
||||
(error "Expected %d arguments, got %d" expected got))
|
||||
(when rest
|
||||
(map-put alist restvar rest))
|
||||
alist))
|
||||
|
||||
(defun doom-dispatch (cmd args &optional show-help)
|
||||
"Parses ARGS and invokes a dispatcher.
|
||||
(defun doom-cli-get (command)
|
||||
"Return a CLI object associated by COMMAND name (string)."
|
||||
(cond ((null command) nil)
|
||||
((doom-cli-p command) command)
|
||||
((doom-cli-get
|
||||
(gethash (cond ((symbolp command) command)
|
||||
((stringp command) (intern command))
|
||||
(command))
|
||||
doom--cli-commands)))))
|
||||
|
||||
If SHOW-HELP is non-nil, show the documentation for said dispatcher."
|
||||
(when (equal cmd "help")
|
||||
(setq show-help t)
|
||||
(when args
|
||||
(setq cmd (car args)
|
||||
args (cdr args))))
|
||||
(let ((fn (doom--dispatch-command cmd)))
|
||||
(unless (fboundp fn)
|
||||
(user-error "%S is not any command *I* know!" cmd))
|
||||
(if show-help
|
||||
(doom--dispatch-help fn args)
|
||||
(let ((start-time (current-time)))
|
||||
(run-hooks 'doom-cli-pre-execute-hook)
|
||||
(unwind-protect
|
||||
(when-let (ret (apply fn args))
|
||||
(print!
|
||||
"\n%s"
|
||||
(success "Finished! (%.4fs)"
|
||||
(float-time
|
||||
(time-subtract (current-time)
|
||||
start-time))))
|
||||
(run-hooks 'doom-cli-post-execute-hook)
|
||||
ret)
|
||||
(run-hooks 'doom-cli-post-error-execute-hook))))))
|
||||
(defun doom-cli-internal-p (cli)
|
||||
"Return non-nil if CLI is an internal (non-public) command."
|
||||
(string-prefix-p ":" (doom-cli-name cli)))
|
||||
|
||||
(defun doom-cli-execute (command &optional args)
|
||||
"Execute COMMAND (string) with ARGS (list of strings).
|
||||
|
||||
Executes a cli defined with `defcli!' with the name or alias specified by
|
||||
COMMAND, and passes ARGS to it."
|
||||
(if-let (cli (doom-cli-get command))
|
||||
(funcall (doom-cli-fn cli)
|
||||
(doom--cli-process cli args))
|
||||
(user-error "Couldn't find any %S command" command)))
|
||||
|
||||
(defmacro defcli! (name speclist &optional docstring &rest body)
|
||||
"Defines a CLI command.
|
||||
|
||||
COMMAND is a symbol or a list of symbols representing the aliases for this
|
||||
command. DOCSTRING is a string description; its first line should be short
|
||||
(under 60 characters), as it will be used as a summary for 'doom help'.
|
||||
|
||||
SPECLIST is a specification for options and arguments, which can be a list
|
||||
specification for an option/switch in the following format:
|
||||
|
||||
(VAR [FLAGS... ARGS...] DESCRIPTION)
|
||||
|
||||
Otherwise, SPECLIST accepts the same argument specifiers as `defun'.
|
||||
|
||||
BODY will be run when this dispatcher is called."
|
||||
(declare (indent 2) (doc-string 3))
|
||||
(unless (stringp docstring)
|
||||
(push docstring body)
|
||||
(setq docstring "TODO"))
|
||||
(let ((names (doom-enlist name))
|
||||
(optlist (cl-remove-if-not #'listp speclist))
|
||||
(arglist (cl-remove-if #'listp speclist))
|
||||
(plist (cl-loop for (key val) on body by #'cddr
|
||||
if (keywordp key)
|
||||
nconc (list key val) into plist
|
||||
else return plist)))
|
||||
`(let ((name ',(car names))
|
||||
(aliases ',(cdr names))
|
||||
(plist ',plist))
|
||||
(when doom--cli-group
|
||||
(setq plist (plist-put plist :group doom--cli-group)))
|
||||
(puthash
|
||||
name
|
||||
(make-doom-cli :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)
|
||||
"TODO"
|
||||
"Declare all enclosed cli commands are part of the NAME group."
|
||||
(declare (indent defun) (doc-string 2))
|
||||
`(let ((doom--cli-group ,name))
|
||||
(puthash doom--cli-group ,docstring doom--cli-groups)
|
||||
,@body))
|
||||
|
||||
(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
|
||||
(defcli! (refresh re) (&rest args)
|
||||
(load! "cli/help")
|
||||
(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.
|
||||
|
||||
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
|
||||
stale."
|
||||
(print! (green "Initiating a refresh of Doom Emacs...\n"))
|
||||
(let ((force-p (or (member "-f" args)
|
||||
(member "--force" args)))
|
||||
success)
|
||||
(let (success)
|
||||
(when (file-exists-p doom-env-file)
|
||||
(doom-reload-env-file 'force))
|
||||
(doom-reload-core-autoloads force-p)
|
||||
(doom-cli-reload-env-file 'force))
|
||||
(doom-cli-reload-core-autoloads force-p)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(and (doom-packages-install doom-auto-accept)
|
||||
(and (doom-cli-packages-install)
|
||||
(setq success t))
|
||||
(and (doom-packages-rebuild doom-auto-accept)
|
||||
(and (doom-cli-packages-build)
|
||||
(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)))
|
||||
(doom-reload-package-autoloads (or success force-p))
|
||||
(doom-byte-compile nil 'recompile))
|
||||
(doom-cli-reload-package-autoloads (or success force-p))
|
||||
(doom-cli-byte-compile nil 'recompile))
|
||||
t))
|
||||
|
||||
|
||||
;; Load all of our subcommands
|
||||
(load! "cli/install")
|
||||
|
||||
(defcligroup! "Diagnostics"
|
||||
"For troubleshooting and diagnostics"
|
||||
(defcli! (doctor doc) ()
|
||||
"Checks for issues with your environment & Doom config.
|
||||
|
||||
Use the doctor to diagnose common problems or list missing dependencies in
|
||||
enabled modules.")
|
||||
|
||||
(load! "cli/doctor")
|
||||
(load! "cli/debug")
|
||||
(load! "cli/test"))
|
||||
|
||||
|
|
@ -205,8 +257,8 @@ enabled modules.")
|
|||
(load! "cli/packages")
|
||||
(load! "cli/autoloads"))
|
||||
|
||||
(defcligroup! "Byte compilation"
|
||||
"For byte-compiling Doom and your config"
|
||||
(defcligroup! "Compilation"
|
||||
"For compiling Doom and your config"
|
||||
(load! "cli/byte-compile"))
|
||||
|
||||
(defcligroup! "Utilities"
|
||||
|
|
@ -214,7 +266,7 @@ enabled modules.")
|
|||
(defcli! run ()
|
||||
"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 -nw init.el
|
||||
|
|
|
|||
33
core/core.el
33
core/core.el
|
|
@ -434,26 +434,27 @@ in interactive sessions, nil otherwise (but logs a warning)."
|
|||
(if (not (file-readable-p file))
|
||||
(unless noerror
|
||||
(signal 'file-error (list "Couldn't read envvar file" file)))
|
||||
(let (vars)
|
||||
(let (environment)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(save-excursion
|
||||
(insert "\n")
|
||||
(insert-file-contents file))
|
||||
(while (re-search-forward "\n *\\([^#][^= \n]+\\)=" nil t)
|
||||
(save-excursion
|
||||
(let ((var (string-trim-left (match-string 1)))
|
||||
(value (buffer-substring-no-properties
|
||||
(point)
|
||||
(1- (or (when (re-search-forward "^\\([^= ]+\\)=" nil t)
|
||||
(line-beginning-position))
|
||||
(point-max))))))
|
||||
(push (cons var value) vars)
|
||||
(setenv var value)))))
|
||||
(when vars
|
||||
(push (buffer-substring
|
||||
(match-beginning 1)
|
||||
(1- (or (save-excursion
|
||||
(when (re-search-forward "^\\([^= ]+\\)=" nil t)
|
||||
(line-beginning-position)))
|
||||
(point-max))))
|
||||
environment)))
|
||||
(when environment
|
||||
(setq-default
|
||||
process-environment environment
|
||||
exec-path (append (parse-colon-path (getenv "PATH"))
|
||||
(list exec-directory))
|
||||
shell-file-name (or (getenv "SHELL")
|
||||
shell-file-name))
|
||||
(nreverse vars)))))
|
||||
t))))
|
||||
|
||||
(defun doom-initialize (&optional force-p)
|
||||
"Bootstrap Doom, if it hasn't already (or if FORCE-P is non-nil).
|
||||
|
|
@ -523,12 +524,6 @@ to least)."
|
|||
(require 'core-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
|
||||
(dolist (dir (list doom-local-dir
|
||||
doom-etc-dir
|
||||
|
|
|
|||
|
|
@ -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."))))))
|
||||
Loading…
Add table
Add a link
Reference in a new issue