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

Rewrite core-cli

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

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

149
core/cli/autoloads.el
View file

@ -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))

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

@ -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)))

21
core/cli/debug.el
View file

@ -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
View file

@ -0,0 +1,209 @@
;;; core/cli/doctor.el -*- lexical-binding: t; -*-
(defvar doom-warnings ())
(defvar doom-errors ())
;;; Helpers
(defun elc-check-dir (dir)
(dolist (file (directory-files-recursively dir "\\.elc$"))
(when (file-newer-than-file-p (concat (file-name-sans-extension file) ".el")
file)
(warn! "%s is out-of-date" (abbreviate-file-name file)))))
(defmacro assert! (condition message &rest args)
`(unless ,condition
(error! ,message ,@args)))
;;; Logging
(defmacro error! (&rest args)
`(progn (unless inhibit-message (print! (error ,@args)))
(push (format! (error ,@args)) doom-errors)))
(defmacro warn! (&rest args)
`(progn (unless inhibit-message (print! (warn ,@args)))
(push (format! (warn ,@args)) doom-warnings)))
(defmacro success! (&rest args)
`(print! (green ,@args)))
(defmacro section! (&rest args)
`(print! (bold (blue ,@args))))
(defmacro explain! (&rest args)
`(print-group! (print! (autofill ,@args))))
;;
;;; CLI commands
(defcli! (doctor doc) ()
"Diagnoses common issues on your system.
The Doom doctor is essentially one big, self-contained elisp shell script that
uses a series of simple heuristics to diagnose common issues on your system.
Issues that could intefere with Doom Emacs.
Doom modules may optionally have a doctor.el file to run their own heuristics
in."
:bare t
(print! "The doctor will see you now...\n")
;; REVIEW Refactor me
(print! (start "Checking your Emacs version..."))
(when EMACS27+
(warn! "Emacs %s detected. Emacs HEAD is unstable and may cause errors."
emacs-version))
(print! (start "Checking for Emacs config conflicts..."))
(when (file-exists-p "~/.emacs")
(warn! "Detected an ~/.emacs file, which may prevent Doom from loading")
(explain! "If Emacs finds an ~/.emacs file, it will ignore ~/.emacs.d, where Doom is "
"typically installed. If you're seeing a vanilla Emacs splash screen, this "
"may explain why. If you use Chemacs, you may ignore this warning."))
(print! (start "Checking for private config conflicts..."))
(let ((xdg-dir (concat (or (getenv "XDG_CONFIG_HOME")
"~/.config")
"/doom/"))
(doom-dir (or (getenv "DOOMDIR")
"~/.doom.d/")))
(when (and (not (file-equal-p xdg-dir doom-dir))
(file-directory-p xdg-dir)
(file-directory-p doom-dir))
(print! (warn "Detected two private configs, in %s and %s")
(abbreviate-file-name xdg-dir)
doom-dir)
(explain! "The second directory will be ignored, as it has lower precedence.")))
(print! (start "Checking for stale elc files..."))
(elc-check-dir user-emacs-directory)
(print! (start "Checking Doom Emacs..."))
(condition-case-unless-debug ex
(print-group!
;; Make sure Doom is initialized and loaded
(let ((doom-interactive-mode t))
(doom-initialize 'force))
(doom-initialize-core)
(print! (success "Initialized Doom Emacs %s") doom-version)
(doom-initialize-modules)
(print!
(if (hash-table-p doom-modules)
(success "Detected %d modules" (hash-table-count doom-modules))
(warn "Failed to load any modules. Do you have an private init.el?")))
(print! (success "Detected %d packages") (length doom-packages))
(print! (start "Checking Doom core for irregularities..."))
(print-group!
;; Check for oversized problem files in cache that may cause unusual/tremendous
;; delays or freezing. This shouldn't happen often.
(dolist (file (list "savehist"
"projectile.cache"))
(let* ((path (expand-file-name file doom-cache-dir))
(size (/ (doom-file-size path) 1024)))
(when (and (numberp size) (> size 1000))
(warn! "%s is too large (%.02fmb). This may cause freezes or odd startup delays"
(relpath path)
(/ size 1024))
(explain! "Consider deleting it from your system (manually)"))))
(unless (ignore-errors (executable-find doom-projectile-fd-binary))
(warn! "Couldn't find the `fd' binary; project file searches will be slightly slower")
(unless (executable-find "rg")
(warn! "Couldn't find the `rg' binary either; project file searches will be even slower")))
(let ((default-directory "~"))
(require 'projectile)
(when (cl-find-if #'projectile-file-exists-p projectile-project-root-files-bottom-up)
(warn! "Your $HOME is recognized as a project root")
(explain! "Doom will disable bottom-up root search, which may reduce the accuracy of project\n"
"detection.")))
;; There should only be one
(when (and (file-equal-p doom-private-dir "~/.config/doom")
(file-directory-p "~/.doom.d"))
(print! (warn "Both %S and '~/.doom.d' exist on your system")
(path doom-private-dir))
(explain! "Doom will only load one of these (~/.config/doom takes precedence). Possessing\n"
"both is rarely intentional; you should one or the other."))
;; Check for fonts
(if (not (fboundp 'find-font))
(progn
(warn! "Warning: unable to detect font")
(explain! "The `find-font' function is missing. This could indicate the incorrect "
"version of Emacs is being used!"))
;; all-the-icons fonts
(when (and (pcase system-type
(`gnu/linux (concat (or (getenv "XDG_DATA_HOME")
"~/.local/share")
"/fonts/"))
(`darwin "~/Library/Fonts/"))
(require 'all-the-icons nil t))
(dolist (font all-the-icons-font-families)
(if (with-temp-buffer
(insert (cdr (doom-call-process "fc-list")))
(re-search-backward "Fira" nil t))
(success! "Found font %s" font)
(print! (warn "Warning: couldn't find %s font in %s")
font font-dest)
(explain! "You can install it by running `M-x all-the-icons-install-fonts' within Emacs.\n\n"
"This could also mean you've installed them in non-standard locations, in which "
"case feel free to ignore this warning."))))))
(print! (start "Checking for stale elc files in your DOOMDIR..."))
(when (file-directory-p doom-private-dir)
(print-group!
(elc-check-dir doom-private-dir)))
(when doom-modules
(print! (start "Checking your enabled modules..."))
(advice-add #'require :around #'doom-shut-up-a)
(maphash (lambda (key plist)
(let (doom-local-errors
doom-local-warnings)
(let (doom-errors
doom-warnings)
(condition-case-unless-debug ex
(let ((doctor-file (doom-module-path (car key) (cdr key) "doctor.el"))
(packages-file (doom-module-path (car key) (cdr key) "packages.el")))
(cl-loop for name in (let (doom-packages
doom-disabled-packages)
(load packages-file 'noerror 'nomessage)
(mapcar #'car doom-packages))
unless (or (doom-package-get name :disable)
(eval (doom-package-get name :ignore))
(doom-package-built-in-p name)
(doom-package-installed-p name))
do (print! (error "%s is not installed") name))
(let ((inhibit-message t))
(load doctor-file 'noerror 'nomessage)))
(file-missing (error! "%s" (error-message-string ex)))
(error (error! "Syntax error: %s" ex)))
(when (or doom-errors doom-warnings)
(print-group!
(print! (start (bold "%s %s")) (car key) (cdr key))
(print! "%s" (string-join (append doom-errors doom-warnings) "\n")))
(setq doom-local-errors doom-errors
doom-local-warnings doom-warnings)))
(appendq! doom-errors doom-local-errors)
(appendq! doom-warnings doom-local-warnings)))
doom-modules)))
(error
(warn! "Attempt to load DOOM failed\n %s\n"
(or (cdr-safe ex) (car ex)))
(setq doom-modules nil)))
;; Final report
(message "")
(dolist (msg (list (list doom-errors "error" 'red)
(list doom-warnings "warning" 'yellow)))
(when (car msg)
(print! (color (nth 2 msg)
(if (cdr msg)
"There are %d %ss!"
"There is %d %s!")
(length (car msg)) (nth 1 msg)))))
(unless (or doom-errors doom-warnings)
(success! "Everything seems fine, happy Emacs'ing!"))
t)

145
core/cli/env.el
View file

@ -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
View file

@ -0,0 +1,101 @@
;;; core/cli/help.el -*- lexical-binding: t; -*-
(defun doom--cli-print-signature (cli)
(print! (bold "Usage: doom %s%s%s")
(if (doom-cli-internal-p cli)
""
(concat (doom-cli-name cli) " "))
(if-let* ((optlist (doom-cli-optlist cli))
(flags (cl-loop for opt in optlist
append (doom-cli-option-flags opt)))
(fn (doom-partial #'string-prefix-p "--")))
(concat (when-let (short-flags (cl-remove-if fn flags))
;; TODO Show arguments of short flags
(format "[-%s]"
(string-join (mapcar (doom-rpartial #'substring 1 nil) short-flags)
"")))
;; TODO Show long flags
;; (when-let (long-flags (cl-remove-if-not fn flags))
;; (concat " " (string-join long-flags " ")))
" ")
"")
(if-let (arglist (doom-cli-arglist cli))
(string-join (append (cl-loop for arg in arglist
until (memq arg cl--lambda-list-keywords)
collect (upcase (symbol-name arg)))
(cl-loop for arg in (cdr (memq '&optional arglist))
until (memq arg cl--lambda-list-keywords)
collect (format "[%s]" (upcase (symbol-name arg)))))
" ")
"")))
(defun doom--cli-print-desc (cli &optional short)
(print! "%s"
(if short
(car (split-string (doom-cli-desc cli) "\n"))
(doom-cli-desc cli))))
(defun doom--cli-print-short-desc (cli)
(doom--cli-print-desc cli 'short))
(defun doom--cli-print-options (cli)
(when-let (optlist (doom-cli-optlist cli))
(print! (bold "Options:"))
(print-group!
(cl-loop for opt in optlist
for flags = (doom-cli-option-flags opt)
for desc = (doom-cli-option-desc opt)
for args = (doom-cli-option-args opt)
for flagstr = (string-join (doom-cli-option-flags opt) ", ")
do
;; TODO Adjust columns dynamically
(print! "%-18s"
(concat flagstr
(when-let (arg (car args))
(concat " " (upcase (symbol-name arg))))))
(print-group!
(print! (autofill "%s") desc))))))
(defun doom--cli-print (cli)
(doom--cli-print-signature cli)
(terpri)
(doom--cli-print-desc cli)
(terpri)
(doom--cli-print-options cli))
;;
;;; Commands
(defcli! (help h) (&optional command)
"Describe a command or list them all."
:bare t
(if command
(doom--cli-print (doom-cli-get (intern command)))
(doom--cli-print (doom-cli-get :main))
(terpri)
(print! (bold "Commands:"))
(print-group!
(dolist (group (seq-group-by (lambda (cli)
(plist-get (doom-cli-plist cli) :group))
(cl-loop for name being the hash-keys of doom--cli-commands
for cli = (gethash name doom--cli-commands)
if (and (doom-cli-p cli)
(not (doom-cli-internal-p cli))
(not (plist-get (doom-cli-plist cli) :hidden)))
collect cli)))
(if (null (car group))
(dolist (cli (cdr group))
(print! "%-16s %s"
(doom-cli-name cli)
(car (split-string (doom-cli-desc cli) "\n"))))
(print! "%-26s %s"
(bold (concat (car group) ":"))
(gethash (car group) doom--cli-groups))
(print-group!
(dolist (cli (cdr group))
(print! "%-16s %s"
(doom-cli-name cli)
(car (split-string (doom-cli-desc cli) "\n"))))))
(terpri)))))

62
core/cli/install.el
View file

@ -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")

464
core/cli/packages.el
View file

@ -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
View file

@ -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)))

31
core/cli/upgrade.el
View file

@ -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."))))))