Moving to Doom Emacs!

This commit is contained in:
Derek Taylor
2019-12-16 20:21:19 -06:00
parent d9f2f456f1
commit d4b4c33550
683 changed files with 51877 additions and 100 deletions

View File

@@ -0,0 +1,407 @@
;;; core/cli/autoloads.el -*- lexical-binding: t; -*-
(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.")
;; externs
(defvar autoload-timestamps)
(defvar generated-autoload-load-name)
(defvar generated-autoload-file)
;;
;;; Helpers
(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)
(when-let (buf (find-buffer-visiting file))
(with-current-buffer buf
(set-buffer-modified-p nil))
(kill-buffer buf))
(delete-file file)
(ignore-errors (delete-file (byte-compile-dest-file file)))
t))
(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--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)
(unless doom-interactive-mode
(add-hook 'doom-cli-post-success-execute-hook #'doom--cli-warn-refresh-session-h))
(let (noninteractive)
(load file 'noerror 'nomessage 'nosuffix)))
((debug error)
(let ((backup-file (concat file ".bk")))
(print! (warn "Copied backup to %s") (relpath backup-file))
(copy-file file backup-file 'overwrite))
(doom--cli-delete-autoloads-file file)
(signal 'doom-autoload-error (list file e))))))
(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
it is nil, it will try to reload both. If FORCE-P (universal argument) do it
even if it doesn't need reloading!"
(or (null file)
(stringp file)
(signal 'wrong-type-argument (list 'stringp file)))
(if (stringp file)
(cond ((file-equal-p file doom-autoload-file)
(doom-cli-reload-core-autoloads force-p))
((file-equal-p file doom-package-autoload-file)
(doom-cli-reload-package-autoloads force-p))
((error "Invalid autoloads file: %s" file)))
(doom-cli-reload-core-autoloads force-p)
(doom-cli-reload-package-autoloads force-p)))
;;
;;; Doom autoloads
(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--cli-generate-autoloads (targets)
(let ((n 0))
(dolist (file targets)
(insert
(with-temp-buffer
(cond ((not (doom-file-cookie-p file "if" t))
(print! (debug "Ignoring %s") (relpath file)))
((let ((generated-autoload-load-name (file-name-sans-extension file))
;; Prevent `autoload-find-file' from firing file hooks,
;; e.g. adding to recentf.
find-file-hook
write-file-functions
;; Prevent a possible source of crashes when there's a
;; syntax error in the autoloads file
debug-on-error)
(quiet! (autoload-generate-file-autoloads file (current-buffer))))
(print! (debug "Nothing in %s") (relpath file)))
((cl-incf n)
(print! (debug "Scanning %s...") (relpath file))))
(buffer-string))))
(print! (class (if (> n 0) 'success 'info)
"Scanned %d file(s)")
n)))
(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
;; Emacs package, should $DOOMDIR/autoload.el exist. Not sure why
;; they'd want to though, so it's an acceptable compromise.
(append (list doom-private-dir)
doom-modules-dirs
(straight--directory-files (straight--build-dir) nil t)
load-path)))
(defvar doom--autoloads-path-cache nil)
(while (re-search-forward "^\\s-*(\\(?:custom-\\)?autoload\\s-+'[^ ]+\\s-+\"\\([^\"]*\\)\"" nil t)
(let ((path (match-string 1)))
(replace-match
(or (cdr (assoc path doom--autoloads-path-cache))
(when-let* ((libpath (or (and allow-internal-paths
(locate-library path nil (cons doom-emacs-dir doom-modules-dirs)))
(locate-library path)))
(libpath (file-name-sans-extension libpath))
(libpath (abbreviate-file-name libpath)))
(push (cons path libpath) doom--autoloads-path-cache)
libpath)
path)
t t nil 1)))))
(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))
(alt-sexp (match-string 1))
(type (car sexp))
(name (doom-unquote (cadr sexp)))
(origin (doom-module-from-path path)))
(cond
((and (not member-p)
alt-sexp)
(push (read alt-sexp) forms))
((memq type '(defun defmacro cl-defun cl-defmacro))
(cl-destructuring-bind (_ _name arglist &rest body) sexp
(appendq!
forms
(list (if member-p
(make-autoload sexp path)
(let ((docstring
(format "THIS FUNCTION DOES NOTHING BECAUSE %s IS DISABLED\n\n%s"
origin
(if (stringp (car body))
(pop body)
"No documentation."))))
(condition-case-unless-debug e
(if alt-sexp
(read alt-sexp)
(append
(list (pcase type
(`defun 'defmacro)
(`cl-defun `cl-defmacro)
(_ type))
name arglist docstring)
(cl-loop for arg in arglist
if (and (symbolp arg)
(not (keywordp arg))
(not (memq arg cl--lambda-list-keywords)))
collect arg into syms
else if (listp arg)
collect (car arg) into syms
finally return (if syms `((ignore ,@syms))))))
('error
(print! "- Ignoring autodef %s (%s)" name e)
nil))))
`(put ',name 'doom-module ',origin)))))
((eq type 'defalias)
(cl-destructuring-bind (_type name target &optional docstring) sexp
(let ((name (doom-unquote name))
(target (doom-unquote target)))
(unless member-p
(setq target #'ignore
docstring
(format "THIS FUNCTION DOES NOTHING BECAUSE %s IS DISABLED\n\n%s"
origin docstring)))
(appendq! forms `((put ',name 'doom-module ',origin)
(defalias ',name #',target ,docstring))))))
(member-p (push sexp forms)))))
forms))
(defun doom--cli-generate-autodefs (targets enabled-targets)
(goto-char (point-max))
(search-backward ";;;***" nil t)
(save-excursion (insert "\n"))
(dolist (path targets)
(insert
(with-temp-buffer
(insert-file-contents path)
(if-let (forms (doom--cli-generate-autodefs-1 path (member path enabled-targets)))
(concat (mapconcat #'prin1-to-string (nreverse forms) "\n")
"\n")
"")))))
(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-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,
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))
;; The following bindings are in `package-generate-autoloads'.
;; Presumably for a good reason, so I just copied them
(backup-inhibited t)
(version-control 'never)
(case-fold-search nil) ; reduce magic
(autoload-timestamps nil)
;; Where we'll store the files we'll scan for autoloads. This should
;; contain *all* autoload files, even in disabled modules, so we can
;; scan those for autodefs. We start with the core libraries.
(targets (doom-glob doom-core-dir "autoload/*.el"))
;; A subset of `targets' in enabled modules
(active-targets (copy-sequence targets)))
(dolist (path (doom-module-load-path 'all-p))
(when-let* ((files (cons (doom-glob path "autoload.el")
(doom-files-in (doom-path path "autoload")
:match "\\.el$")))
(files (delq nil files)))
(appendq! targets files)
(when (or (doom-module-from-path path 'enabled-only)
(file-equal-p path doom-private-dir))
(appendq! active-targets files))))
(print! (start "Checking core autoloads file"))
(print-group!
(if (and (not force-p)
(file-exists-p doom-autoload-file)
(not (file-newer-than-file-p doom-emacs-dir doom-autoload-file))
(not (cl-loop for dir
in (append (doom-glob doom-private-dir "init.el*")
targets)
if (file-newer-than-file-p dir doom-autoload-file)
return t)))
(ignore
(print! (success "Skipping core autoloads, they are up-to-date"))
(doom-load-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))
(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--cli-byte-compile-file doom-autoload-file)
(print-group!
(print! (success "Compiled %s") (relpath doom-autoload-file)))))
t)))
;;
;;; Package autoloads
(defun doom--generate-package-autoloads ()
"Concatenates package autoload files, let-binds `load-file-name' around
them,and remove unnecessary `provide' statements or blank links."
(dolist (pkg (hash-table-keys straight--build-cache))
(unless (member pkg doom-autoload-excluded-packages)
(let ((file (straight--autoloads-file pkg)))
(when (file-exists-p file)
(insert-file-contents file)
(save-excursion
(while (re-search-forward "\\(?:\\_<load-file-name\\|#\\$\\)\\_>" nil t)
;; `load-file-name' is meaningless in a concatenated
;; mega-autoloads file, so we replace references to it and #$ with
;; the file they came from.
(unless (doom-point-in-string-or-comment-p)
(replace-match (prin1-to-string (abbreviate-file-name file))
t t))))
(while (re-search-forward "^\\(?:;;\\(.*\n\\)\\|\n\\|(provide '[^\n]+\\)" nil t)
(unless (doom-point-in-string-p)
(replace-match "" t t)))
(unless (bolp) (insert "\n")))))))
(defun doom--generate-var-cache ()
"Print a `setq' form for expensive-to-initialize variables, so we can cache
them in Doom's autoloads file."
(doom-initialize-packages)
(prin1 `(setq load-path ',load-path
auto-mode-alist ',auto-mode-alist
Info-directory-list ',Info-directory-list
doom-disabled-packages ',doom-disabled-packages)
(current-buffer)))
(defun doom--cleanup-package-autoloads ()
"Remove (some) forms that modify `load-path' or `auto-mode-alist'.
These variables are cached all at once and at later, so these removed statements
served no purpose but to waste cycles."
(while (re-search-forward "^\\s-*\\((\\(?:add-to-list\\|\\(?:when\\|if\\) (boundp\\)\\s-+'\\(?:load-path\\|auto-mode-alist\\)\\)" nil t)
(goto-char (match-beginning 1))
(kill-sexp)))
(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'.
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)
(file-exists-p doom-package-autoload-file)
(not (file-newer-than-file-p package-user-dir doom-package-autoload-file))
(not (cl-loop for dir in (straight--directory-files (straight--build-dir))
if (cl-find-if
(lambda (dir)
(file-newer-than-file-p dir doom-package-autoload-file))
(doom-glob (straight--build-dir dir) "*.el"))
return t))
(not (cl-loop with doom-modules = (doom-modules)
for key being the hash-keys of doom-modules
for path = (doom-module-path (car key) (cdr key) "packages.el")
if (file-newer-than-file-p path doom-package-autoload-file)
return t)))
(ignore
(print! (success "Skipping package autoloads, they are up-to-date"))
(doom-load-autoloads-file doom-package-autoload-file))
(let (;; The following bindings are in `package-generate-autoloads'.
;; Presumably for a good reason, so I just copied them
(backup-inhibited t)
(version-control 'never)
(case-fold-search nil) ; reduce magic
(autoload-timestamps nil))
(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))
(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")))
;; 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"))))
;; 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--cli-byte-compile-file doom-package-autoload-file)
(print-group!
(print! (success "Compiled %s") (relpath doom-package-autoload-file))))))
t))

View File

@@ -0,0 +1,204 @@
;;; core/cli/byte-compile.el -*- lexical-binding: t; -*-
(defcli! (compile c)
((recompile-p ["-r" "--recompile"])
&rest targets)
"Byte-compiles your config or selected modules.
compile [TARGETS...]
compile :core :private lang/python
compile feature lang
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-cli-byte-compile targets recompile-p))
(defcli! clean ()
"Delete all *.elc files."
:bare t
(doom-clean-byte-compiled-files))
;;
;; Helpers
(defun doom--byte-compile-ignore-file-p (path)
(let ((filename (file-name-nondirectory path)))
(or (string-prefix-p "." filename)
(string-prefix-p "test-" filename)
(not (equal (file-name-extension path) "el"))
(member filename (list "packages.el" "doctor.el")))))
(cl-defun doom-cli-byte-compile (&optional modules recompile-p)
"Byte compiles your emacs configuration.
init.el is always byte-compiled by this.
If MODULES is specified (a list of module strings, e.g. \"lang/php\"), those are
byte-compiled. Otherwise, all enabled modules are byte-compiled, including Doom
core. It always ignores unit tests and files with `no-byte-compile' enabled.
WARNING: byte-compilation yields marginal gains and makes debugging new issues
difficult. It is recommended you don't use it unless you understand the
reprecussions.
Use `doom-clean-byte-compiled-files' or `make clean' to reverse
byte-compilation.
If RECOMPILE-P is non-nil, only recompile out-of-date files."
(let ((default-directory doom-emacs-dir)
(doom-modules (doom-modules))
(byte-compile-verbose doom-debug-mode)
(byte-compile-warnings '(not free-vars unresolved noruntime lexical make-local))
;; In case it is changed during compile-time
(auto-mode-alist auto-mode-alist)
(noninteractive t)
targets)
(let (target-dirs)
(dolist (module (delete-dups modules))
(pcase module
(":core"
(push (doom-glob doom-emacs-dir "init.el") targets)
(push doom-core-dir target-dirs))
(":private"
(push doom-private-dir target-dirs))
((pred file-directory-p)
(push module target-dirs))
((pred (string-match "^\\([^/]+\\)/\\([^/]+\\)$"))
(push (doom-module-locate-path
(doom-keyword-intern (match-string 1 module))
(intern (match-string 2 module)))
target-dirs))
(_ (user-error "%S is not a valid target" module))))
(and (or (null modules) (member ":private" modules))
(not recompile-p)
(not (or doom-auto-accept
(y-or-n-p
(concat "Warning: byte compiling is for advanced users. It will interfere with your\n"
"efforts to debug issues. It is not recommended you do it if you frequently\n"
"tinker with your Emacs config.\n\n"
"Alternatively, use `bin/doom compile :core` instead to byte-compile only the\n"
"Doom core files, as these don't change often.\n\n"
"If you have issues, please make sure byte-compilation isn't the cause by using\n"
"`bin/doom clean` to clear out your *.elc files.\n\n"
"Byte-compile anyway?"))))
(user-error "Aborting"))
;; But first we must be sure that Doom and your private config have been
;; fully loaded. Which usually aren't so in an noninteractive session.
(let ((doom-interactive-mode 'byte-compile))
(doom-initialize)
(doom-initialize-packages)
(doom-initialize-core))
;;
(unless target-dirs
(push (doom-glob doom-emacs-dir "init.el") targets)
;; If no targets were supplied, then we use your module list.
(appendq! target-dirs
(list doom-core-dir)
(nreverse
(cl-remove-if-not
(lambda (path) (file-in-directory-p path doom-emacs-dir))
;; Omit `doom-private-dir', which is always first
(cdr (doom-module-load-path))))))
;; Assemble el files we want to compile; taking into account that MODULES
;; may be a list of MODULE/SUBMODULE strings from the command line.
(appendq! targets
(doom-files-in target-dirs
:match "\\.el$"
:filter #'doom--byte-compile-ignore-file-p)))
(unless targets
(print!
(if targets
(warn "Couldn't find any valid targets")
(info "No targets to %scompile" (if recompile-p "re" ""))))
(cl-return nil))
(print!
(start (if recompile-p
"Recompiling stale elc files..."
"Byte-compiling your config (may take a while)...")))
(print-group!
(require 'use-package)
(condition-case e
(let ((total-ok 0)
(total-fail 0)
(total-noop 0)
(use-package-defaults use-package-defaults)
(use-package-expand-minimally t)
kill-emacs-hook kill-buffer-query-functions)
;; Prevent packages from being loaded at compile time if they
;; don't meet their own predicates.
(push (list :no-require t
(lambda (_name args)
(or (when-let (pred (or (plist-get args :if)
(plist-get args :when)))
(not (eval pred t)))
(when-let (pred (plist-get args :unless))
(eval pred t)))))
use-package-defaults)
(unless recompile-p
(doom-clean-byte-compiled-files))
(dolist (target (delete-dups (delq nil targets)))
(cl-incf
(if (not (or (not recompile-p)
(let ((elc-file (byte-compile-dest-file target)))
(and (file-exists-p elc-file)
(file-newer-than-file-p target elc-file)))))
total-noop
(pcase (if (doom-file-cookie-p target "if" t)
(byte-compile-file target)
'no-byte-compile)
(`no-byte-compile
(print! (info "Ignored %s") (relpath target))
total-noop)
(`nil
(print! (error "Failed to compile %s") (relpath target))
total-fail)
(_
(print! (success "Compiled %s") (relpath target))
(load target t t)
total-ok)))))
(print! (class (if (= total-fail 0) 'success 'error)
"%s %d/%d file(s) (%d ignored)")
(if recompile-p "Recompiled" "Compiled")
total-ok (- (length targets) total-noop)
total-noop)
t)
((debug error)
(print! (error "\nThere were breaking errors.\n\n%s")
"Reverting changes...")
(signal 'doom-error (list 'byte-compile e)))))))
(defun doom-clean-byte-compiled-files ()
"Delete all the compiled elc files in your Emacs configuration and private
module. This does not include your byte-compiled, third party packages.'"
(require 'core-modules)
(print! (start "Cleaning .elc files"))
(print-group!
(cl-loop with default-directory = doom-emacs-dir
with success = nil
for path
in (append (doom-glob doom-emacs-dir "*.elc")
(doom-files-in doom-private-dir :match "\\.elc$" :depth 1)
(doom-files-in doom-core-dir :match "\\.elc$")
(doom-files-in doom-modules-dirs :match "\\.elc$" :depth 4))
if (file-exists-p path)
do (delete-file path)
and do (print! (success "Deleted %s") (relpath path))
and do (setq success t)
finally do
(print! (if success
(success "All elc files deleted")
(info "No elc files to clean"))))
t))

View File

@@ -0,0 +1,29 @@
;;; core/cli/debug.el -*- lexical-binding: t; -*-
;;
;;; Commands
(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)
(with-temp-buffer
(insert (json-encode (doom-info)))
(json-pretty-print-buffer)
(print! (buffer-string))))
("--md"
(doom/info))
((or `nil "--lisp")
(doom/info 'raw))
(_
(user-error "I don't understand %S. Did you mean --json, --md/--markdown or --lisp?"
format)))
nil)
(defcli! (version v) ()
"Show version information for Doom & Emacs."
:bare t
(doom/version)
nil)

203
.emacs.d/core/cli/doctor.el Normal file
View File

@@ -0,0 +1,203 @@
;;; 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!
(let ((doom-interactive-mode 'doctor))
(doom-initialize 'force)
(doom-initialize-core)
(doom-initialize-modules))
(print! (success "Initialized Doom Emacs %s") doom-version)
(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"))
(when-let (size (ignore-errors (doom-file-size file doom-cache-dir)))
(when (> size 1048576) ; larger than 1mb
(warn! "%s is too large (%.02fmb). This may cause freezes or odd startup delays"
file (/ 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")))
(require 'projectile)
(when (projectile-project-root "~")
(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))
(with-temp-buffer
(insert (cdr (doom-call-process "fc-list")))
(dolist (font all-the-icons-font-names)
(if (save-excursion (re-search-backward font nil t))
(success! "Found font %s" font)
(print! (warn "Warning: couldn't find %S font") font)
(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)

131
.emacs.d/core/cli/env.el Normal file
View File

@@ -0,0 +1,131 @@
;;; core/cli/env.el -*- lexical-binding: t; -*-
(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."))
"Creates or regenerates your envvars file.
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)
to ensure Emacs mirrors your shell environment (particularly to ensure PATH and
SHELL are correctly set).
This is useful in cases where you cannot guarantee that Emacs (or the daemon)
will be launched from the correct environment (e.g. on MacOS or through certain
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.
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)))
(delete-file env-file)
(print! (success "Successfully deleted %S")
(path env-file)))
(args
(user-error "I don't understand 'doom env %s'"
(string-join args " ")))
((doom-cli-reload-env-file 'force env-file)))))
;;
;; Helpers
(defvar doom-env-ignored-vars
'("^DBUS_SESSION_BUS_ADDRESS$"
"^GPG_AGENT_INFO$"
"^GPG_TTY$"
"^HOME$"
"^PS1$"
"^PWD$"
"^R?PROMPT$"
"^SSH_AGENT_PID$"
"^SSH_AUTH_SOCK$"
"^TERM$"
;; Doom envvars
"^DEBUG$"
"^INSECURE$"
"^YES$"
"^__")
"Environment variables to not save in `doom-env-file'.
Each string is a regexp, matched against variable names to omit from
`doom-env-file'.")
(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
`doom-env-executable' through `shell-file-name' with `doom-env-switches'. By
default, on Linux, this is '$SHELL -ic /usr/bin/env'. Variables in
`doom-env-ignored-vars' are removed."
(let ((env-file (if env-file
(expand-file-name env-file)
doom-env-file)))
(when (or force-p (not (file-exists-p env-file)))
(with-temp-file env-file
(print! (start "%s envvars file at %S")
(if (file-exists-p env-file)
"Regenerating"
"Generating")
(path env-file))
(let ((process-environment doom--initial-process-environment))
(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 (car (split-string env "=")))
doom-env-ignored-vars)
(print! (info "Ignoring %s") env)
(insert env "\n")))
(print! (success "Successfully generated %S")
(path env-file))
t))))))

102
.emacs.d/core/cli/help.el Normal file
View File

@@ -0,0 +1,102 @@
;;; 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)))))
" ")
""))
(when-let (aliases (doom-cli-aliases cli))
(print! "Aliases: %s" (string-join aliases ", "))))
(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 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)))))

View File

@@ -0,0 +1,102 @@
;;; core/cli/install.el -*- lexical-binding: t; -*-
(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:
1. Creates DOOMDIR at ~/.doom.d,
2. Copies ~/.emacs.d/init.example.el to $DOOMDIR/init.el (if it doesn't exist),
3. Creates dummy files for $DOOMDIR/{config,packages}.el,
4. Prompts you to generate an envvar file (same as 'doom env'),
5. Installs any dependencies of enabled modules (specified by $DOOMDIR/init.el),
6. And prompts to install all-the-icons' fonts
This command is idempotent and safe to reuse.
The location of DOOMDIR can be changed with the -p option, or by setting the
DOOMDIR environment variable. e.g.
doom -p ~/.config/doom install
DOOMDIR=~/.config/doom doom install"
:bare t
(print! (green "Installing Doom Emacs!\n"))
(let ((default-directory (doom-path "~")))
;; Create `doom-private-dir'
(if noconfig-p
(print! (warn "Not copying private config template, as requested"))
(print! (start "Creating %s") (relpath doom-private-dir))
(make-directory doom-private-dir 'parents)
(print-group!
(print! (success "Created %s") (relpath doom-private-dir)))
;; Create init.el, config.el & packages.el
(mapc (lambda (file)
(cl-destructuring-bind (filename . fn) file
(if (file-exists-p! filename doom-private-dir)
(print! (warn "%s already exists, skipping") filename)
(print! (info "Creating %s%s") (relpath doom-private-dir) filename)
(with-temp-file (doom-path doom-private-dir filename)
(funcall fn))
(print! (success "Done!")))))
'(("init.el" .
(lambda ()
(insert-file-contents (doom-path doom-emacs-dir "init.example.el"))))
("config.el" .
(lambda ()
(insert! ";;; %sconfig.el -*- lexical-binding: t; -*-\n\n"
";; Place your private configuration here\n"
((relpath doom-private-dir)))))
("packages.el" .
(lambda ()
(insert! ";; -*- no-byte-compile: t; -*-\n;;; %spackages.el\n\n"
";;; Examples:\n"
";; (package! some-package)\n"
";; (package! another-package :recipe (:host github :repo \"username/repo\"))\n"
";; (package! builtin-package :disable t)\n"
((relpath doom-private-dir))))))))
;; 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 'force 'noerror)
(doom-initialize-modules)
;; 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 noinstall-p
(print! (warn "Not installing plugins, as requested"))
(print! "Installing plugins")
(doom-cli-packages-install))
(print! "Regenerating autoloads files")
(doom-cli-reload-autoloads nil 'force-p)
(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)
(let ((window-system (cond (IS-MAC 'ns)
(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")
(print! (buffer-string)))))

View File

@@ -0,0 +1,317 @@
;; -*- no-byte-compile: t; -*-
;;; core/cli/packages.el
(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."
(straight-check-all)
(doom-cli-reload-core-autoloads)
(when (doom-cli-packages-update)
(doom-cli-reload-package-autoloads 'force-p))
t)
(defcli! (build b)
((rebuild-p ["-r"] "Only rebuild packages that need rebuilding"))
"Byte-compiles & symlinks installed packages.
This ensures that all needed files are symlinked from their package repo and
their elisp files are byte-compiled. This is especially necessary if you upgrade
Emacs (as byte-code is generally not forward-compatible)."
(when (doom-cli-packages-build (not rebuild-p))
(doom-cli-reload-package-autoloads 'force-p))
t)
(defcli! (purge p)
((nobuilds-p ["-b" "--no-builds"] "Don't purge unneeded (built) packages")
(noelpa-p ["-p" "--no-elpa"] "Don't purge ELPA packages")
(norepos-p ["-r" "--no-repos"] "Don't purge unused straight repos")
(regraft-p ["-g" "--regraft"] "Regraft git repos (ie. compact them)"))
"Deletes orphaned packages & repos, and compacts them.
Purges all installed ELPA packages (as they are considered temporary). Purges
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.
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)
;; (defcli! rollback () ; TODO doom rollback
;; "<Not implemented yet>"
;; (user-error "Not implemented yet, sorry!"))
;;
;;; Library
(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."
(print! (start "Installing & building packages..."))
(print-group!
(let ((n 0))
(dolist (package (hash-table-keys straight--recipe-cache))
(straight--with-plist (gethash package straight--recipe-cache)
(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 (make-string (1- (or doom-format-indent 1)) 32))
(not existed-p)
(file-directory-p (straight--repos-dir package))
(cl-incf n))
(error
(signal 'doom-package-error
(list e (straight--process-get-output))))))))
(if (= n 0)
(ignore (print! (success "No packages need to be installed")))
(print! (success "Installed & built %d packages") n)
t))))
(defun doom-cli-packages-build (&optional force-p)
"(Re)build all packages."
(print! (start "(Re)building %spackages...") (if force-p "all " ""))
(print-group!
(let ((n 0))
(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)
(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))
;; REVIEW We do these modification checks manually because
;; Straight's checks seem to miss stale elc files. Need
;; more tests to confirm this.
(when (or (ignore-errors
(gethash package straight--packages-to-rebuild))
(gethash package straight--cached-package-modifications)
(not (file-directory-p (straight--build-dir package)))
(cl-loop for file
in (doom-files-in (straight--build-dir package)
:match "\\.el$"
:full t)
for elc-file = (byte-compile-dest-file file)
if (and (file-exists-p elc-file)
(file-newer-than-file-p file elc-file))
return t))
(let ((straight-use-package-pre-build-functions
straight-use-package-pre-build-functions))
(add-hook 'straight-use-package-pre-build-functions
(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
(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))
(straight--byte-compile-package recipe)))))))))
(if (= n 0)
(ignore (print! (success "No packages need rebuilding")))
(doom--finalize-straight)
(print! (success "Rebuilt %d package(s)" n))
t))))
(defun doom-cli-packages-update ()
"Updates packages."
(print! (start "Updating packages (this may take a while)..."))
;; TODO Refactor me
(let ((straight--repos-dir (straight--repos-dir))
(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)))
(if (not (file-in-directory-p default-directory straight--repos-dir))
(print! (warn "[%d/%d] Skipping %s because it is local")
i total package)
(let ((commit (straight-vc-get-commit type local-repo)))
(if (not (straight-vc-fetch-from-remote recipe))
(print! (warn "\033[K(%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! (start "\033[K(%d/%d) %s is up-to-date\033[1A") i total package)
(ignore-errors
(delete-directory (straight--build-dir package) 'recursive))
(puthash package t straight--packages-to-rebuild)
(print! (info "\033[K(%d/%d) Updating %s...") i total package)
(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))))))
(print! (success "(%d/%d) %s updated (%s -> %s)") i total package
(substring commit 0 7)
(substring newcommit 0 7))))))))
(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)))))
(princ "\033[K")
(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--cli-packages-purge-build (build)
(let ((build-dir (straight--build-dir 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--cli-packages-purge-builds (builds)
(if (not builds)
(progn (print! (info "No builds to purge"))
0)
(length
(delq nil (mapcar #'doom--cli-packages-purge-build builds)))))
(defun doom--cli-packages-regraft-repo (repo)
(let ((default-directory (straight--repos-dir repo)))
(if (not (file-directory-p ".git"))
(ignore (print! (warn "\033[Krepos/%s is not a git repo, skipping" 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 "\033[Krepos/%s is already compact\033[1A" repo))
(straight--call "git" "gc")
(print! (success "\033[KRegrafted 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--cli-packages-regraft-repos (repos)
(if (not repos)
(progn (print! (info "No repos to regraft"))
0)
(let ((before-size (doom-directory-size (straight--repos-dir))))
(print-group!
(prog1 (delq nil (mapcar #'doom--cli-packages-regraft-repo repos))
(princ "\033[K")
(let ((after-size (doom-directory-size (straight--repos-dir))))
(print! (success "Finished regrafting. Size before: %0.1fKB and after: %0.1fKB (%0.1fKB)")
before-size after-size
(- after-size before-size))))))))
(defun doom--cli-packages-purge-repo (repo)
(let ((repo-dir (straight--repos-dir repo)))
(delete-directory repo-dir 'recursive)
(ignore-errors
(delete-file (straight--modified-file repo)))
(if (file-directory-p repo-dir)
(ignore (print! (error "Failed to purge repos/%s" repo)))
(print! (success "Purged repos/%s" repo))
t)))
(defun doom--cli-packages-purge-repos (repos)
(if (not repos)
(progn (print! (info "No repos to purge"))
0)
(length
(delq nil (mapcar #'doom--cli-packages-purge-repo repos)))))
(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
for dir = (package-desc-dir desc)
if (file-in-directory-p dir package-user-dir)
collect (cons package dir))))
(if (not package-alist)
(progn (print! (info "No ELPA packages to purge"))
0)
(mapc (doom-rpartial #'delete-directory 'recursive)
(mapcar #'cdr packages))
(length packages))))
(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
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)."
(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))
(bdirs (straight--directory-files (straight--build-dir) nil nil 'sort)))
(list (cl-remove-if (doom-rpartial #'gethash straight--profile-cache)
bdirs)
(cl-remove-if (doom-rpartial #'straight--checkhash straight--repo-cache)
rdirs)
(cl-remove-if-not (doom-rpartial #'straight--checkhash straight--repo-cache)
rdirs)))
(let (success)
(print-group!
(if (not builds-p)
(print! (info "Skipping builds"))
(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--cli-packages-purge-elpa))
(setq success t)))
(if (not repos-p)
(print! (info "Skipping repos"))
(and (/= 0 (doom--cli-packages-purge-repos repos-to-purge))
(setq success t)))
(if (not regraft-repos-p)
(print! (info "Skipping regrafting"))
(print! (start "Regrafting %d repos..." (length repos-to-regraft)))
(and (doom--cli-packages-regraft-repos repos-to-regraft)
(setq success t)))
(when success
(doom--finalize-straight)
t)))))

104
.emacs.d/core/cli/test.el Normal file
View File

@@ -0,0 +1,104 @@
;;; core/cli/test.el -*- lexical-binding: t; -*-
(defun doom--emacs-binary ()
(let ((emacs-binary-path (doom-path invocation-directory invocation-name))
(runemacs-binary-path (if IS-WINDOWS (doom-path invocation-directory "runemacs.exe"))))
(if (and runemacs-binary-path (file-exists-p runemacs-binary-path))
runemacs-binary-path
emacs-binary-path)))
(defcli! test (&rest targets)
"Run Doom unit tests."
:bare t
(doom-initialize 'force 'noerror)
(require 'ansi-color)
(let (files read-files)
(unless targets
(setq targets
(cons doom-core-dir
(cl-remove-if-not
(doom-rpartial #'file-in-directory-p doom-emacs-dir)
;; Omit `doom-private-dir', which is always first
(let (doom-modules)
(load (expand-file-name "test/init" doom-core-dir) nil t)
(cdr (doom-module-load-path)))))))
(while targets
(let ((target (pop targets)))
;; FIXME Module targets don't work
(cond ((equal target ":core")
(appendq! files (nreverse (doom-glob doom-core-dir "test/test-*.el"))))
((file-directory-p target)
(setq target (expand-file-name target))
(appendq! files (nreverse (doom-glob target "test/test-*.el"))))
((file-exists-p target)
(push target files)))))
(setenv "DOOMLOCALDIR" (concat doom-local-dir "test/"))
(setenv "DOOMDIR" (concat doom-core-dir "test/"))
(with-temp-buffer
(print! (start "Bootstrapping test environment, if necessary..."))
(cl-destructuring-bind (status . output)
(doom-exec-process
(doom--emacs-binary)
"--batch"
"--eval"
(prin1-to-string
`(progn
(setq user-emacs-directory ,doom-emacs-dir
doom-auto-accept t)
(require 'core ,(locate-library "core"))
(require 'core-cli)
(doom-initialize 'force 'noerror)
(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)))

View File

@@ -0,0 +1,113 @@
;;; core/cli/upgrade.el -*- lexical-binding: t; -*-
(defcli! (upgrade up)
((force-p ["-f" "--force"]))
"Updates Doom and packages.
This requires that ~/.emacs.d is a git repo, and is the equivalent of the
following shell commands:
cd ~/.emacs.d
git pull --rebase
bin/doom clean
bin/doom refresh
bin/doom update"
:bare t
(if (delq
nil (list
(doom-cli-upgrade doom-auto-accept force-p)
(doom-cli-execute "refresh")
(when (doom-cli-packages-update)
(doom-cli-reload-package-autoloads 'force)
t)))
(print! (success "Done! Restart Emacs for changes to take effect."))
(print! "Nothing to do. Doom is up-to-date!")))
;;
;;; library
(defvar doom-repo-url "https://github.com/hlissner/doom-emacs"
"The git repo url for Doom Emacs.")
(defvar doom-repo-remote "_upgrade"
"The name to use as our staging remote.")
(defun doom--working-tree-dirty-p (dir)
(cl-destructuring-bind (success . stdout)
(doom-call-process "git" "status" "--porcelain" "-uno")
(if (= 0 success)
(split-string stdout "\n" t)
(error "Failed to check working tree in %s" dir))))
(defun doom-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)
process-file-side-effects)
(print! (start "Preparing to upgrade Doom Emacs and its packages..."))
(let* ((branch (vc-git--symbolic-ref doom-emacs-dir))
(target-remote (format "%s/%s" doom-repo-remote branch)))
(unless branch
(error! (if (file-exists-p! ".git" doom-emacs-dir)
"Couldn't find Doom's .git directory. Was Doom cloned properly?"
"Couldn't detect what branch you're on. Is Doom detached?")))
;; We assume that a dirty .emacs.d is intentional and abort
(when-let (dirty (doom--working-tree-dirty-p default-directory))
(if (not force-p)
(user-error! "%s\n\n%s\n\n %s"
(format "Refusing to upgrade because %S has been modified." (path doom-emacs-dir))
"Either stash/undo your changes or run 'doom upgrade -f' to discard local changes."
(string-join dirty "\n"))
(print! (info "You have local modifications in Doom's source. Discarding them..."))
(doom-call-process "git" "reset" "--hard" (format "origin/%s" branch))
(doom-call-process "git" "clean" "-ffd")))
(doom-call-process "git" "remote" "remove" doom-repo-remote)
(unwind-protect
(let (result)
(or (zerop (car (doom-call-process "git" "remote" "add" doom-repo-remote doom-repo-url)))
(error "Failed to add %s to remotes" doom-repo-remote))
(or (zerop (car (setq result (doom-call-process "git" "fetch" "--tags" doom-repo-remote branch))))
(error "Failed to fetch from upstream"))
(let ((this-rev (vc-git--rev-parse "HEAD"))
(new-rev (vc-git--rev-parse target-remote)))
(cond
((and (null this-rev)
(null new-rev))
(error "Failed to get revisions for %s" target-remote))
((equal this-rev new-rev)
(print! (success "Doom is already up-to-date!"))
t)
((print! (info "A new version of Doom Emacs is available!\n\n Old revision: %s (%s)\n New revision: %s (%s)\n"
(substring this-rev 0 10)
(cdr (doom-call-process "git" "log" "-1" "--format=%cr" "HEAD"))
(substring new-rev 0 10)
(cdr (doom-call-process "git" "log" "-1" "--format=%cr" target-remote))))
(when (and (not auto-accept-p)
(y-or-n-p "View the comparison diff in your browser?"))
(print! (info "Opened github in your browser."))
(browse-url (format "https://github.com/hlissner/doom-emacs/compare/%s...%s"
this-rev
new-rev)))
(if (not (or auto-accept-p
(y-or-n-p "Proceed with upgrade?")))
(ignore (print! (error "Aborted")))
(print! (start "Upgrading Doom Emacs..."))
(print-group!
(doom-clean-byte-compiled-files)
(if (and (zerop (car (doom-call-process "git" "reset" "--hard" target-remote)))
(equal (vc-git--rev-parse "HEAD") new-rev))
(print! (info "%s") (cdr result))
(error "Failed to check out %s" (substring new-rev 0 10)))
(print! (success "Finished upgrading Doom Emacs")))
t)))))
(ignore-errors
(doom-call-process "git" "remote" "remove" doom-repo-remote))))))