refactor!: restructure Doom core
BREAKING CHANGE: This restructures the project in preparation for Doom to be split into two repos. Users that have reconfigured Doom's CLI stand a good chance of seeing breakage, especially if they've referred to any core-* feature, e.g. (after! core-cli-ci ...) To fix it, simply s/core-/doom-/, i.e. (after! doom-cli-ci ...) What this commit specifically changes is: - Renames all core features from core-* to doom-* - Moves core/core-* -> lisp/doom-* - Moves core/autoloads/* -> lisp/lib/* - Moves core/templates -> templates/ Ref: #4273
This commit is contained in:
Henrik Lissner
parent
a9866e37e4
commit
b9933e6637
69 changed files with 147 additions and 145 deletions
241
lisp/cli/autoloads.el
Normal file
241
lisp/cli/autoloads.el
Normal file
|
|
@ -0,0 +1,241 @@
|
|||
;;; lisp/cli/autoloads.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defvar doom-autoloads-excluded-packages ()
|
||||
"What packages whose autoloads files we won't index.
|
||||
|
||||
These packages 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.")
|
||||
|
||||
(defvar doom-autoloads-excluded-files ()
|
||||
"List of regexps whose matching files won't be indexed for autoloads.")
|
||||
|
||||
(defvar doom-autoloads-cached-vars
|
||||
'(doom-modules
|
||||
doom-disabled-packages
|
||||
native-comp-deferred-compilation-deny-list
|
||||
load-path
|
||||
auto-mode-alist
|
||||
interpreter-mode-alist
|
||||
Info-directory-list)
|
||||
"A list of variables to be cached in `doom-autoloads-file'.")
|
||||
|
||||
(defvar doom-autoloads-files ()
|
||||
"A list of additional files or file globs to scan for autoloads.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Library
|
||||
|
||||
(defun doom-autoloads-reload (&optional file)
|
||||
"Regenerates Doom's autoloads and writes them to FILE."
|
||||
(unless file
|
||||
;; TODO Uncomment when profile system is implemented
|
||||
;; (make-directory doom-profile-dir t)
|
||||
;; (setq file (expand-file-name "init.el" doom-profile-dir))
|
||||
(setq file doom-autoloads-file))
|
||||
(print! (start "(Re)generating autoloads file..."))
|
||||
(print-group!
|
||||
(cl-check-type file string)
|
||||
(doom-initialize-packages)
|
||||
(and (print! (start "Generating autoloads file..."))
|
||||
(doom-autoloads--write
|
||||
file
|
||||
`((unless (equal doom-version ,doom-version)
|
||||
(signal 'doom-error
|
||||
(list "The installed version of Doom has changed since last 'doom sync' ran"
|
||||
"Run 'doom sync' to bring Doom up to speed"))))
|
||||
(cl-loop for var in doom-autoloads-cached-vars
|
||||
when (boundp var)
|
||||
collect `(set ',var ',(symbol-value var)))
|
||||
(doom-autoloads--scan
|
||||
(append (doom-glob doom-core-dir "lib/*.el")
|
||||
(cl-loop for dir
|
||||
in (append (cdr (doom-module-load-path 'all-p))
|
||||
(list doom-private-dir))
|
||||
if (doom-glob dir "autoload.el") collect (car it)
|
||||
if (doom-glob dir "autoload/*.el") append it)
|
||||
(mapcan #'doom-glob doom-autoloads-files))
|
||||
nil)
|
||||
(doom-autoloads--scan
|
||||
(mapcar #'straight--autoloads-file
|
||||
(seq-difference (hash-table-keys straight--build-cache)
|
||||
doom-autoloads-excluded-packages))
|
||||
doom-autoloads-excluded-files
|
||||
'literal)
|
||||
;; TODO Uncomment when profile system is implemented
|
||||
;; `((unless noninteractive (require 'doom-start)))
|
||||
)
|
||||
(print! (start "Byte-compiling autoloads file..."))
|
||||
(doom-autoloads--compile-file file)
|
||||
(print! (success "Generated %s")
|
||||
(relpath (byte-compile-dest-file file)
|
||||
doom-emacs-dir)))))
|
||||
|
||||
(defun doom-autoloads--write (file &rest forms)
|
||||
(make-directory (file-name-directory file) 'parents)
|
||||
(condition-case-unless-debug e
|
||||
(with-temp-file file
|
||||
(setq-local coding-system-for-write 'utf-8)
|
||||
(let ((standard-output (current-buffer))
|
||||
(print-quoted t)
|
||||
(print-level nil)
|
||||
(print-length nil))
|
||||
(insert ";; -*- lexical-binding: t; coding: utf-8; no-native-compile: t -*-\n"
|
||||
";; This file is autogenerated by 'doom sync', DO NOT EDIT IT!!\n")
|
||||
(dolist (form (delq nil forms))
|
||||
(mapc #'prin1 form))
|
||||
t))
|
||||
(error (delete-file file)
|
||||
(signal 'doom-autoload-error (list file e)))))
|
||||
|
||||
(defun doom-autoloads--compile-file (file)
|
||||
(condition-case-unless-debug e
|
||||
(let ((byte-compile-warnings (if init-file-debug byte-compile-warnings)))
|
||||
(and (byte-compile-file file)
|
||||
(load (byte-compile-dest-file file) nil t)))
|
||||
(error
|
||||
(delete-file (byte-compile-dest-file file))
|
||||
(signal 'doom-autoload-error (list file e)))))
|
||||
|
||||
(defun doom-autoloads--cleanup-form (form &optional expand)
|
||||
(let ((func (car-safe form)))
|
||||
(cond ((memq func '(provide custom-autoload))
|
||||
nil)
|
||||
((and (eq func 'add-to-list)
|
||||
(memq (doom-unquote (cadr form))
|
||||
doom-autoloads-cached-vars))
|
||||
nil)
|
||||
((not (eq func 'autoload))
|
||||
form)
|
||||
((and expand (not (file-name-absolute-p (nth 2 form))))
|
||||
(defvar doom--autoloads-path-cache nil)
|
||||
(setf (nth 2 form)
|
||||
(let ((path (nth 2 form)))
|
||||
(or (cdr (assoc path doom--autoloads-path-cache))
|
||||
(when-let* ((libpath (locate-library path))
|
||||
(libpath (file-name-sans-extension libpath))
|
||||
(libpath (abbreviate-file-name libpath)))
|
||||
(push (cons path libpath) doom--autoloads-path-cache)
|
||||
libpath)
|
||||
path)))
|
||||
form)
|
||||
(form))))
|
||||
|
||||
(defun doom-autoloads--scan-autodefs (file buffer module &optional module-enabled-p)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(while (re-search-forward "^;;;###autodef *\\([^\n]+\\)?\n" nil t)
|
||||
(let* ((standard-output buffer)
|
||||
(form (read (current-buffer)))
|
||||
(altform (match-string 1))
|
||||
(definer (car-safe form))
|
||||
(symbol (doom-unquote (cadr form))))
|
||||
(cond ((and (not module-enabled-p) altform)
|
||||
(print (read altform)))
|
||||
((memq definer '(defun defmacro cl-defun cl-defmacro))
|
||||
(print
|
||||
(if module-enabled-p
|
||||
(make-autoload form file)
|
||||
(seq-let (_ _ arglist &rest body) form
|
||||
(if altform
|
||||
(read altform)
|
||||
(append
|
||||
(list (pcase definer
|
||||
(`defun 'defmacro)
|
||||
(`cl-defun `cl-defmacro)
|
||||
(_ type))
|
||||
symbol arglist
|
||||
(format "THIS FUNCTION DOES NOTHING BECAUSE %s IS DISABLED\n\n%s"
|
||||
module (if (stringp (car body))
|
||||
(pop body)
|
||||
"No documentation.")))
|
||||
(cl-loop for arg in arglist
|
||||
if (symbolp arg)
|
||||
if (not (keywordp arg))
|
||||
if (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)))))))))
|
||||
(print `(put ',symbol 'doom-module ',module)))
|
||||
((eq definer 'defalias)
|
||||
(seq-let (_ _ target docstring) form
|
||||
(unless module-enabled-p
|
||||
(setq target #'ignore
|
||||
docstring
|
||||
(format "THIS FUNCTION DOES NOTHING BECAUSE %s IS DISABLED\n\n%s"
|
||||
module docstring)))
|
||||
(print `(put ',symbol 'doom-module ',module))
|
||||
(print `(defalias ',symbol #',(doom-unquote target) ,docstring))))
|
||||
(module-enabled-p (print form)))))))
|
||||
|
||||
(defvar autoload-timestamps)
|
||||
(defvar generated-autoload-load-name)
|
||||
(defun doom-autoloads--scan-file (file)
|
||||
(let* (;; 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
|
||||
;; Non-nil interferes with autoload generation in Emacs < 29. See
|
||||
;; radian-software/straight.el#904.
|
||||
(left-margin 0)
|
||||
;; 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 ; reduce magic
|
||||
autoload-timestamps ; reduce noise in generated files
|
||||
;; So `autoload-generate-file-autoloads' knows where to write it
|
||||
(generated-autoload-load-name (file-name-sans-extension file))
|
||||
(target-buffer (current-buffer))
|
||||
(module (doom-module-from-path file))
|
||||
(module-enabled-p (and (or (memq (car module) '(:core :private))
|
||||
(doom-module-p (car module) (cdr module)))
|
||||
(doom-file-cookie-p file "if" t))))
|
||||
(save-excursion
|
||||
(when module-enabled-p
|
||||
(quiet! (autoload-generate-file-autoloads file target-buffer)))
|
||||
(doom-autoloads--scan-autodefs
|
||||
file target-buffer module module-enabled-p))))
|
||||
|
||||
(defun doom-autoloads--scan (files &optional exclude literal)
|
||||
"Scan and return all autoloaded forms in FILES.
|
||||
|
||||
Autoloads will be generated from autoload cookies in FILES (except those that
|
||||
match one of the regexps in EXCLUDE -- a list of strings). If LITERAL is
|
||||
non-nil, treat FILES as pre-generated autoload files instead."
|
||||
(require 'autoload)
|
||||
(let (autoloads)
|
||||
(dolist (file files (nreverse (delq nil autoloads)))
|
||||
(when (and (not (seq-find (doom-rpartial #'string-match-p file) exclude))
|
||||
(file-readable-p file))
|
||||
(doom-log "Scanning %s" file)
|
||||
(setq file (file-truename file))
|
||||
(with-temp-buffer
|
||||
(if literal
|
||||
(insert-file-contents file)
|
||||
(doom-autoloads--scan-file file))
|
||||
(save-excursion
|
||||
(while (re-search-forward "\\_<load-file-name\\_>" nil t)
|
||||
;; `load-file-name' is meaningless in a concatenated
|
||||
;; mega-autoloads file, but also essential in isolation, so we
|
||||
;; replace references to it with the file they came from.
|
||||
(let ((ppss (save-excursion (syntax-ppss))))
|
||||
(or (nth 3 ppss)
|
||||
(nth 4 ppss)
|
||||
(replace-match (prin1-to-string file) t t)))))
|
||||
(let ((load-file-name file)
|
||||
(load-path
|
||||
(append (list doom-private-dir)
|
||||
doom-modules-dirs
|
||||
load-path)))
|
||||
(condition-case _
|
||||
(while t
|
||||
(push (doom-autoloads--cleanup-form (read (current-buffer))
|
||||
(not literal))
|
||||
autoloads))
|
||||
(end-of-file))))))))
|
||||
472
lisp/cli/ci.el
Normal file
472
lisp/cli/ci.el
Normal file
|
|
@ -0,0 +1,472 @@
|
|||
;;; lisp/cli/ci.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
(defvar doom-ci-commit-trailer-keys
|
||||
'(("Fix" ref hash url)
|
||||
("Ref" ref hash url)
|
||||
("Close" ref)
|
||||
("Revert" ref hash)
|
||||
("Amend" ref hash)
|
||||
("Co-authored-by" name)
|
||||
("Signed-off-by" name))
|
||||
"An alist of valid trailer keys and their accepted value types.
|
||||
|
||||
Accapted value types can be one or more of ref, hash, url, username, or name.")
|
||||
|
||||
(defvar doom-ci-commit-trailer-types
|
||||
'((ref . "^\\(https?://[^ ]+\\|[^/]+/[^/]+\\)?#[0-9]+$")
|
||||
(hash . "^\\(https?://[^ ]+\\|[^/]+/[^/]+@\\)?[a-z0-9]\\{12\\}$")
|
||||
(url . "^https?://")
|
||||
(name . "^[a-zA-Z0-9-_ \\.']+<[^@]+@[^.]+\\.[^>]+>$")
|
||||
(username . "^@[^a-zA-Z0-9_-]+$"))
|
||||
"An alist of valid trailer keys and their accepted value types.
|
||||
|
||||
Accapted value types can be one or more of ref, hash, url, username, or name.")
|
||||
|
||||
(defvar doom-ci-commit-types
|
||||
'(bump dev docs feat fix merge nit perf refactor release revert test tweak)
|
||||
"A list of valid commit types.")
|
||||
|
||||
(defvar doom-ci-commit-scopeless-types '(bump merge release revert)
|
||||
"A list of commit types whose scopes should be passed in its BODY.
|
||||
|
||||
Don't: \"bump(SCOPE): ...\"
|
||||
Do: \"bump: SCOPE\"")
|
||||
|
||||
(defvar doom-ci-commit-scopes '("ci" doom-ci-enforce-scopeless-types)
|
||||
"A list of valid commit scopes as strings, predicate functions, or lists.
|
||||
|
||||
These are checked against each item in the comma-delimited scope field of the
|
||||
current commit's message. E.g. 'fix(foo,bar,baz): ...' => foo, bar and baz
|
||||
|
||||
Each element of this list can be one of:
|
||||
|
||||
- A string, compared literally against the scope's name.
|
||||
- A function predicate, taking two arguments (a scope as a symbol, and a plist
|
||||
containing information about the current commit--see `doom-ci-commit-scopes'
|
||||
for more about its structure). These predicates should:
|
||||
- Return non-nil to immediately pass a scope.
|
||||
- Throw a `user-error' to immediately fail the scope.
|
||||
- Return nil to continue with the checks in this list.
|
||||
- A list, denoting type-specific scopes. Its CAR is the type as a symbol, and
|
||||
its CDR is a nested list of scopes as strings/predicates. E.g.
|
||||
|
||||
'(docs \"faq\" \"install\" check-docs)")
|
||||
|
||||
(defvar doom-ci-commit-rules
|
||||
;; TODO Extract into named functions
|
||||
(list (lambda! (&key subject)
|
||||
"If a fixup/squash commit, don't lint this commit"
|
||||
(when (string-match "^\\(\\(?:fixup\\|squash\\)!\\|FIXUP\\|WIP\\) " subject)
|
||||
(skip! (format "Found %S commit, skipping commit" (match-string 1 subject)))))
|
||||
|
||||
(lambda! (&key type subject)
|
||||
"Test SUBJECT length"
|
||||
(let ((len (length subject)))
|
||||
(cond ((memq type '(bump revert)))
|
||||
((<= len 10)
|
||||
(fail! "Subject is too short (<10) and should be more descriptive"))
|
||||
((<= len 20)
|
||||
(warn! "Subject is short (<20); are you sure it's descriptive enough?"))
|
||||
((> len 72)
|
||||
(fail! "Subject is %d characters, above the 72 maximum"
|
||||
len))
|
||||
((> len 50)
|
||||
(warn! "Subject is %d characters; <=50 is ideal"
|
||||
len)))))
|
||||
|
||||
(lambda! (&key type)
|
||||
"Ensure commit has valid type"
|
||||
(or (memq type doom-ci-commit-types)
|
||||
(if type
|
||||
(fail! "Invalid commit type: %s" type)
|
||||
(fail! "Commit has no detectable type"))))
|
||||
|
||||
(lambda! (&key summary)
|
||||
"Ensure commit has a summary"
|
||||
(when (or (not (stringp summary))
|
||||
(string-blank-p summary))
|
||||
(fail! "Commit has no summary")))
|
||||
|
||||
(lambda! (&key type summary subject)
|
||||
"Ensure summary isn't needlessly capitalized"
|
||||
(and (stringp summary)
|
||||
(string-match-p "^[A-Z][^-A-Z.]" summary)
|
||||
(fail! "%S in summary should not be capitalized"
|
||||
(car (split-string summary " ")))))
|
||||
|
||||
(lambda! (&rest plist &key type scopes)
|
||||
"Ensure scopes are valid"
|
||||
(dolist (scope scopes)
|
||||
(condition-case e
|
||||
(letf! (defun* check-rule (rule)
|
||||
(or (and (stringp rule)
|
||||
(string= rule scope))
|
||||
(and (functionp rule)
|
||||
(funcall rule scope plist))
|
||||
(and (listp rule)
|
||||
(eq type (car rule))
|
||||
(seq-find #'check-rule (cdr rule)))))
|
||||
(or (seq-find #'check-rule doom-ci-commit-scopes)
|
||||
(fail! "Invalid scope: %s" scope)))
|
||||
(user-error (fail! "%s" (error-message-string e))))))
|
||||
|
||||
(lambda! (&key scopes)
|
||||
"Esnure scopes are sorted correctly"
|
||||
(unless (equal scopes (sort (copy-sequence scopes) #'string-lessp))
|
||||
(fail! "Scopes are not in lexicographical order")))
|
||||
|
||||
(lambda! (&key type body)
|
||||
"Enforce 72 character line width for BODY"
|
||||
(catch 'result
|
||||
(with-temp-buffer
|
||||
(save-excursion (insert body))
|
||||
(while (re-search-forward "^[^\n]\\{73,\\}" nil t)
|
||||
(save-excursion
|
||||
(or
|
||||
;; Long bump lines are acceptable
|
||||
(let ((bump-re "\\(https?://.+\\|[^/]+\\)/[^/]+@[a-z0-9]\\{12\\}"))
|
||||
(re-search-backward (format "^%s -> %s$" bump-re bump-re) nil t))
|
||||
;; Long URLs are acceptable
|
||||
(re-search-backward "https?://[^ ]+\\{73,\\}" nil t)
|
||||
;; Lines that start with # or whitespace are comment or
|
||||
;; code blocks.
|
||||
(re-search-backward "^\\(?:#\\| +\\)" nil t)
|
||||
(throw 'result (fail! "Line(s) in commit body exceed 72 characters"))))))))
|
||||
|
||||
(lambda! (&key bang body type)
|
||||
"Ensure ! is accompanied by a 'BREAKING CHANGE:' in BODY"
|
||||
(if bang
|
||||
(cond ((not (string-match-p "^BREAKING CHANGE:" body))
|
||||
(fail! "'!' present in commit type, but missing 'BREAKING CHANGE:' in body"))
|
||||
((not (string-match-p "^BREAKING CHANGE: .+" body))
|
||||
(fail! "'BREAKING CHANGE:' present in commit body, but missing explanation")))
|
||||
(when (string-match-p "^BREAKING CHANGE:" body)
|
||||
(fail! "'BREAKING CHANGE:' present in body, but missing '!' after %S"
|
||||
type))))
|
||||
|
||||
(lambda! (&key type body)
|
||||
"Ensure bump commits have package ref lines"
|
||||
(and (eq type 'bump)
|
||||
(let ((bump-re "\\(?:https?://.+\\|[^/]+\\)/[^/]+@\\([a-z0-9]+\\)"))
|
||||
(not (string-match-p (concat "^" bump-re " -> " bump-re "$")
|
||||
body)))
|
||||
(fail! "Bump commit is missing commit hash diffs")))
|
||||
|
||||
(lambda! (&key body)
|
||||
"Ensure commit hashes in bump lines are 12 characters long"
|
||||
(with-temp-buffer
|
||||
(insert body)
|
||||
(let ((bump-re "\\<\\(?:https?://[^@]+\\|[^/]+\\)/[^/]+@\\([a-z0-9]+\\)")
|
||||
refs)
|
||||
(while (re-search-backward bump-re nil t)
|
||||
(when (/= (length (match-string 1)) 12)
|
||||
(push (match-string 0) refs)))
|
||||
(when refs
|
||||
(fail! "%d commit hash(s) not 12 characters long: %s"
|
||||
(length refs) (string-join (nreverse refs) ", "))))))
|
||||
|
||||
;; TODO Add bump validations for revert: type.
|
||||
(lambda! (&key body trailers)
|
||||
"Validate commit trailers."
|
||||
(let* ((keys (mapcar #'car doom-ci-commit-trailer-keys))
|
||||
(key-re (regexp-opt keys t))
|
||||
(lines
|
||||
;; Scan BODY because invalid trailers won't be in TRAILERS.
|
||||
(save-match-data
|
||||
(and (string-match "\n\\(\n[a-zA-Z][a-zA-Z-]*:? [^ ][^\n]+\\)+\n+\\'" body)
|
||||
(split-string (match-string 0 body) "\n" t)))))
|
||||
(dolist (line lines)
|
||||
(unless (string-match-p (concat "^" key-re ":? [^ ]") line)
|
||||
(fail! "Found %S, expected one of: %s"
|
||||
(truncate-string-to-width (string-trim line) 16 nil nil "…")
|
||||
(string-join keys ", ")))
|
||||
(when (and (string-match "^[^a-zA-Z-]+:? \\(.+\\)$" line)
|
||||
(string-match-p " " (match-string 1 line)))
|
||||
(fail! "%S has multiple references, but should only have one per line"
|
||||
(truncate-string-to-width (string-trim line) 20 nil nil "…")))
|
||||
(when (or (string-match (concat "^" key-re "\\(?:e?[sd]\\|ing\\)? [^ ]") line)
|
||||
(string-match (concat "^\\([a-zA-Z-]+\\) [^ \n]+$") line))
|
||||
(fail! "%S missing colon after %S"
|
||||
(truncate-string-to-width (string-trim line) 16 nil nil "…")
|
||||
(match-string 1 line))))
|
||||
(pcase-dolist (`(,key . ,value) trailers)
|
||||
(if (and (not (memq 'name (cdr (assoc key doom-ci-commit-trailer-keys))))
|
||||
(string-match-p " " value))
|
||||
(fail! "Found %S, but only one value allowed per trailer"
|
||||
(truncate-string-to-width (concat key ": " value) 20 nil nil "…"))
|
||||
(when-let (allowed-types (cdr (assoc key doom-ci-commit-trailer-keys)))
|
||||
(or (cl-loop for type in allowed-types
|
||||
if (cdr (assq type doom-ci-commit-trailer-types))
|
||||
if (string-match-p it value)
|
||||
return t)
|
||||
(fail! "%S expects one of %s, but got %S"
|
||||
key allowed-types value)))))))
|
||||
|
||||
;; TODO Check that bump/revert SUBJECT list: 1) valid modules and 2)
|
||||
;; modules whose files are actually being touched.
|
||||
|
||||
;; TODO Ensure your diff corraborates your SCOPE
|
||||
|
||||
)
|
||||
"A list of validator functions to run against a commit.
|
||||
|
||||
Each function is N-arity and is passed a plist with the following keys:
|
||||
|
||||
:bang
|
||||
(Boolean) If `t', the commit is declared to contain a breaking change.
|
||||
e.g. 'refactor!: this commit breaks everything'
|
||||
:body
|
||||
(String) Contains the whole BODY of a commit message, excluding the
|
||||
TRAILERS.
|
||||
:scopes
|
||||
(List<Symbol>) Contains a list of scopes, as symbols. e.g. with
|
||||
'feat(org,lsp): so on and so forth', this contains '(org lsp).
|
||||
:subject
|
||||
(String) Contains the whole first line of a commit message.
|
||||
:summary
|
||||
(String) Contains the summary following the type and scopes. e.g. In
|
||||
'feat(org): fix X, Y, and Z' the summary is 'fix X, Y, and Z.
|
||||
:trailers
|
||||
(Map<String, String>) Contains an alist of 'KEY: VALUE' trailers, i.e. All
|
||||
Fix, Ref, Close, Revert, etc lines with a valid value. This will be empty if
|
||||
the formatting of a commit's trailers is invalid.
|
||||
:type
|
||||
(Symbol) The type of commit this is. E.g. `feat', `fix', `bump', etc.
|
||||
|
||||
Each function should call `fail!' or `warn!' one or more times, or `skip!'
|
||||
(immediately returns). Each of these lexical functions take the same arguments
|
||||
as `format'.
|
||||
|
||||
Note: warnings are not considered failures.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
;;; doom ci
|
||||
(defcli! (:before ci) (&args _)
|
||||
(when-let*
|
||||
((repo-root
|
||||
(if-let* ((result (sh! "git" "rev-parse" "--show-toplevel"))
|
||||
((zerop (car result))))
|
||||
(cdr result)
|
||||
default-directory))
|
||||
(local-config
|
||||
(car (or (doom-glob repo-root "ci.el")
|
||||
(doom-glob doom-private-dir "ci.el")))))
|
||||
(defgroup! :prefix '(doom ci)
|
||||
(load local-config nil t t))
|
||||
(print! (item "Loaded %S") local-config)))
|
||||
|
||||
(defcli! ci (&args _)
|
||||
"Commands that automate development processes."
|
||||
:partial t)
|
||||
|
||||
(defcli! (ci deploy-hooks) ((force ("--force")))
|
||||
"TODO"
|
||||
(let* ((repo-path (sh! "git" "rev-parse" "--show-toplevel"))
|
||||
(repo-path (if (zerop (car repo-path))
|
||||
(cdr repo-path)
|
||||
(user-error "Cannot locate a git repo in %s"
|
||||
(file-relative-name default-directory))))
|
||||
(submodule-p (string-empty-p (cdr (sh! "git" "rev-parse" "show-superproject-working-tree"))))
|
||||
(config-hooks-path (cdr (sh! "git" "config" "core.hooksPath")))
|
||||
(hooks-path (cdr (sh! "git" "rev-parse" "--git-path" "hooks"))))
|
||||
(unless (string-empty-p config-hooks-path)
|
||||
(or force
|
||||
(y-or-n-p
|
||||
(format (concat "Detected non-standard core.hookPath: %S\n\n"
|
||||
"Install Doom's commit-msg and pre-push git hooks anyway?")
|
||||
hooks-path))
|
||||
(user-error "Aborted")))
|
||||
(make-directory hooks-path 'parents)
|
||||
(print-group!
|
||||
(dolist (hook '("commit-msg" "pre-push"))
|
||||
(let* ((hook (doom-path hooks-path hook))
|
||||
(overwrite-p (file-exists-p hook)))
|
||||
(with-temp-file hook
|
||||
(insert "#!/usr/bin/env sh\n"
|
||||
(doom-path doom-emacs-dir "bin/doom")
|
||||
" --no-color ci hook " (file-name-base hook)
|
||||
" \"$@\""))
|
||||
(set-file-modes hook #o700)
|
||||
(print! (success "%s %s")
|
||||
(if overwrite-p "Overwrote" "Created")
|
||||
(path hook)))))))
|
||||
|
||||
(defcli! (ci lint-commits) (from &optional to)
|
||||
"TODO"
|
||||
(with-temp-buffer
|
||||
(insert
|
||||
(cdr (doom-call-process
|
||||
"git" "log"
|
||||
(format "%s...%s" from (or to (concat from "~1"))))))
|
||||
(doom-ci--lint
|
||||
(let (commits)
|
||||
(while (re-search-backward "^commit \\([a-z0-9]\\{40\\}\\)" nil t)
|
||||
(push (cons (match-string 1)
|
||||
(replace-regexp-in-string
|
||||
"^ " ""
|
||||
(save-excursion
|
||||
(buffer-substring-no-properties
|
||||
(search-forward "\n\n")
|
||||
(if (re-search-forward "\ncommit \\([a-z0-9]\\{40\\}\\)" nil t)
|
||||
(match-beginning 0)
|
||||
(point-max))))))
|
||||
commits))
|
||||
commits))))
|
||||
|
||||
;;; TODO
|
||||
(defstub! (ci run-tests))
|
||||
|
||||
;;; doom ci hook
|
||||
(defcli! (ci hook commit-msg) (file)
|
||||
"Run git commit-msg hook.
|
||||
|
||||
Lints the current commit message."
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(doom-ci--lint
|
||||
`(("CURRENT" .
|
||||
,(buffer-substring
|
||||
(point-min)
|
||||
(if (re-search-forward "^# Please enter the commit message" nil t)
|
||||
(match-beginning 0)
|
||||
(point-max))))))))
|
||||
|
||||
(defcli! (ci hook pre-push) (remote url)
|
||||
"Run git pre-push hook.
|
||||
|
||||
Prevents pushing if there are unrebased or WIP commits."
|
||||
(with-temp-buffer
|
||||
(let ((z40 (make-string 40 ?0))
|
||||
line error)
|
||||
(while (setq line (ignore-errors (read-from-minibuffer "")))
|
||||
(catch 'continue
|
||||
(seq-let (local-ref local-sha remote-ref remote-sha)
|
||||
(split-string line " ")
|
||||
;; TODO Extract this branch detection to a variable
|
||||
(unless (or (string-match-p "^refs/heads/\\(master\\|main\\)$" remote-ref)
|
||||
(equal local-sha z40))
|
||||
(throw 'continue t))
|
||||
(print-group!
|
||||
(mapc (lambda (commit)
|
||||
(seq-let (hash msg) (split-string commit "\t")
|
||||
(setq error t)
|
||||
(print! (item "%S commit in %s"
|
||||
(car (split-string msg " "))
|
||||
(substring hash 0 12)))))
|
||||
(split-string
|
||||
(cdr (doom-call-process
|
||||
"git" "rev-list"
|
||||
"--grep" (concat "^" (regexp-opt '("WIP" "squash!" "fixup!" "FIXUP") t) " ")
|
||||
"--format=%H\t%s"
|
||||
(if (equal remote-sha z40)
|
||||
local-sha
|
||||
(format "%s..%s" remote-sha local-sha))))
|
||||
"\n" t))
|
||||
(when error
|
||||
(print! (error "Aborting push due to unrebased WIP, squash!, or fixup! commits"))
|
||||
(exit! 1)))))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(cl-defun doom-ci-enforce-scopeless-types (scope (&key type scopes summary &allow-other-keys))
|
||||
"Complain about scoped commit types that shouldn't be scoped."
|
||||
(when (memq type doom-ci-commit-scopeless-types)
|
||||
(user-error "Scopes for %s commits should go after the colon, not before"
|
||||
type)))
|
||||
|
||||
|
||||
(defun doom-ci--parse-commit (commit-msg)
|
||||
(with-temp-buffer
|
||||
(save-excursion (insert commit-msg))
|
||||
(append
|
||||
(let ((end
|
||||
(save-excursion
|
||||
(if (re-search-forward "\n\\(\n[a-zA-Z-]+: [^ ][^\n]+\\)+\n*\\'" nil t)
|
||||
(1+ (match-beginning 0))
|
||||
(point-max)))))
|
||||
`(:subject ,(buffer-substring (point-min) (line-end-position))
|
||||
:body ,(string-trim-right (buffer-substring (line-beginning-position 3) end))
|
||||
:trailers ,(save-match-data
|
||||
(cl-loop with footer = (buffer-substring end (point-max))
|
||||
for line in (split-string footer "\n" t)
|
||||
if (string-match "^\\([a-zA-Z-]+\\): \\(.+\\)$" line)
|
||||
collect (cons (match-string 1 line) (match-string 2 line))))))
|
||||
(save-match-data
|
||||
(when (looking-at "^\\([a-zA-Z0-9_-]+\\)\\(!?\\)\\(?:(\\([^)]+\\))\\)?: \\([^\n]+\\)")
|
||||
`(:type ,(intern (match-string 1))
|
||||
:bang ,(equal (match-string 2) "!")
|
||||
:summary ,(match-string 4)
|
||||
:scopes ,(ignore-errors (split-string (match-string 3) ",")))))
|
||||
(save-excursion
|
||||
(let ((bump-re "\\(\\(?:https?://.+\\|[^/ \n]+\\)/[^/ \n]+@[a-z0-9]\\{12\\}\\)")
|
||||
bumps)
|
||||
(while (re-search-forward (format "^\\s-*\\<%s -> %s\\>" bump-re bump-re) nil t)
|
||||
(cond ((rassoc (match-string 1) bumps)
|
||||
(setcdr (rassoc (match-string 1) bumps) (match-string 2)))
|
||||
((assoc (match-string 2) bumps)
|
||||
(setcar (assoc (match-string 2) bumps) (match-string 1)))
|
||||
((setf (alist-get (match-string 1) bumps nil nil #'equal)
|
||||
(match-string 2)))))
|
||||
`(:bumps ,(cl-sort (delete-dups bumps) #'string-lessp :key #'car)))))))
|
||||
|
||||
(defun doom-ci--parse-bumps (from end)
|
||||
(with-temp-buffer
|
||||
(save-excursion
|
||||
(insert
|
||||
(cdr (doom-call-process "git" "log" "--format=full" "--grep=\\(bump\\|revert\\):"
|
||||
(format "%s...%s" from end)))))
|
||||
(save-match-data
|
||||
(let (packages)
|
||||
(while (let ((bump-re "\\(\\(?:https?://.+\\|[^/ ]+\\)/[^/ ]+@[a-z0-9]\\{12\\}\\)"))
|
||||
(re-search-forward (format "^\\s-*\\<%s -> %s\\>" bump-re bump-re) nil t))
|
||||
(cond ((rassoc (match-string 1) packages)
|
||||
(setcdr (rassoc (match-string 1) packages) (match-string 2)))
|
||||
((assoc (match-string 2) packages)
|
||||
(setcar (assoc (match-string 2) packages) (match-string 1)))
|
||||
((setf (alist-get (match-string 1) packages nil nil #'equal)
|
||||
(match-string 2)))))
|
||||
(cl-sort (delete-dups packages) #'string-lessp :key #'car)))))
|
||||
|
||||
(defun doom-ci--lint (commits)
|
||||
(let ((warnings 0)
|
||||
(failures 0))
|
||||
(print! (start "Linting %d commits" (length commits)))
|
||||
(print-group!
|
||||
(pcase-dolist (`(,ref . ,commitmsg) commits)
|
||||
(let* ((commit (doom-ci--parse-commit commitmsg))
|
||||
(shortref (substring ref 0 7))
|
||||
(subject (plist-get commit :subject)))
|
||||
(cl-block 'linter
|
||||
(letf! ((defun skip! (reason &rest args)
|
||||
(print! (warn "Skipped because: %s") (apply #'format reason args))
|
||||
(cl-return-from 'linter))
|
||||
(defun warn! (reason &rest args)
|
||||
(cl-incf warnings)
|
||||
(print! (warn "%s") (apply #'format reason args)))
|
||||
(defun fail! (reason &rest args)
|
||||
(cl-incf failures)
|
||||
(print! (error "%s") (apply #'format reason args))))
|
||||
(print! (start "%s %s") shortref subject)
|
||||
(print-group!
|
||||
(mapc (doom-rpartial #'apply commit)
|
||||
doom-ci-commit-rules)))))))
|
||||
(let ((issues (+ warnings failures)))
|
||||
(if (= issues 0)
|
||||
(print! (success "There were no issues!"))
|
||||
(if (> warnings 0) (print! (warn "Warnings: %d" warnings)))
|
||||
(if (> failures 0) (print! (warn "Failures: %d" failures)))
|
||||
(print! "\nSee https://discourse.doomemacs.org/git-conventions")
|
||||
(unless (zerop failures)
|
||||
(exit! 1)))
|
||||
t)))
|
||||
|
||||
(provide 'doom-cli-ci)
|
||||
;;; ci.el ends here
|
||||
217
lisp/cli/compile.el
Normal file
217
lisp/cli/compile.el
Normal file
|
|
@ -0,0 +1,217 @@
|
|||
;;; lisp/cli/commands/byte-compile.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
;; None yet!
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! ((compile c))
|
||||
((recompile-p ("-r" "--recompile"))
|
||||
(core-p ("-c" "--core"))
|
||||
(private-p ("-p" "--private"))
|
||||
(verbose-p ("-v" "--verbose")))
|
||||
"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 build' instead."
|
||||
(doom-cli-compile
|
||||
(if (or core-p private-p)
|
||||
(append (if core-p (doom-glob doom-emacs-dir "init.el"))
|
||||
(if core-p (list doom-core-dir))
|
||||
(if private-p (list doom-private-dir)))
|
||||
(or (y-or-n-p
|
||||
(concat "WARNING: Changes made to your config after compiling it won't take effect until\n"
|
||||
"this command is rerun or you run 'doom clean'! It will also make error backtraces\n"
|
||||
"much more difficult to decipher.\n\n"
|
||||
"If you intend to use it anyway, remember this or it will come back to bite you!\n\n"
|
||||
"Continue anyway?"))
|
||||
(user-error "Aborted"))
|
||||
(append (doom-glob doom-emacs-dir "init.el")
|
||||
(list doom-core-dir)
|
||||
(seq-filter
|
||||
;; Only compile Doom's modules
|
||||
(doom-rpartial #'file-in-directory-p doom-emacs-dir)
|
||||
;; Omit `doom-private-dir', which is always first
|
||||
(cdr (doom-module-load-path)))))
|
||||
recompile-p
|
||||
verbose-p))
|
||||
|
||||
(defcli! clean ()
|
||||
"Delete all *.elc files."
|
||||
(doom-compile-clean))
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(cl-defun doom-cli-compile (&optional targets recompile-p verbose-p)
|
||||
"Byte compiles your emacs configuration.
|
||||
|
||||
init.el is always byte-compiled by this.
|
||||
|
||||
If TARGETS is specified, as a list of direcotries
|
||||
|
||||
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-compile-clean' 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)
|
||||
(targets (nreverse (delete-dups targets)))
|
||||
;; In case it is changed during compile-time
|
||||
(auto-mode-alist auto-mode-alist)
|
||||
kill-emacs-hook kill-buffer-query-functions)
|
||||
|
||||
(let ((after-load-functions
|
||||
(if (null targets)
|
||||
after-load-functions
|
||||
;; Assemble el files we want to compile, and preserve in the order
|
||||
;; they are loaded in, so we don't run into any scary catch-22s
|
||||
;; while byte-compiling, like missing macros.
|
||||
(cons (let ((target-dirs (seq-filter #'file-directory-p targets)))
|
||||
(lambda (path)
|
||||
(and (not (doom-compile--ignore-file-p path))
|
||||
(seq-find (doom-partial #'file-in-directory-p path)
|
||||
target-dirs)
|
||||
(cl-pushnew path targets))))
|
||||
after-load-functions))))
|
||||
(doom-log "Reloading Doom in preparation for byte-compilation")
|
||||
;; 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 ((load-prefer-newer t)
|
||||
(noninteractive t))
|
||||
(require 'doom-start)
|
||||
(quiet! (doom-initialize-packages))
|
||||
(quiet! (doom-initialize-modules))))
|
||||
|
||||
(if (null targets)
|
||||
(print! (item "No targets to %scompile" (if recompile-p "re" "")))
|
||||
(print! (start "%scompiling your config...")
|
||||
(if recompile-p "Re" "Byte-"))
|
||||
|
||||
(dolist (dir
|
||||
(cl-remove-if-not #'file-directory-p targets)
|
||||
(setq targets (cl-remove-if #'file-directory-p targets)))
|
||||
(prependq! targets
|
||||
(doom-files-in
|
||||
dir :match "\\.el" :filter #'doom-compile--ignore-file-p)))
|
||||
|
||||
(print-group!
|
||||
(require 'use-package)
|
||||
(condition-case-unless-debug e
|
||||
(let* ((total-ok 0)
|
||||
(total-fail 0)
|
||||
(total-noop 0)
|
||||
(byte-compile-verbose nil)
|
||||
(byte-compile-warnings '(not free-vars unresolved noruntime lexical make-local))
|
||||
(byte-compile-dynamic-docstrings t)
|
||||
(use-package-compute-statistics nil)
|
||||
(use-package-defaults use-package-defaults)
|
||||
(use-package-expand-minimally t)
|
||||
(targets (delete-dups targets))
|
||||
(modules (seq-group-by #'doom-module-from-path targets))
|
||||
(total-files (length targets))
|
||||
(total-modules (length modules))
|
||||
(i 0)
|
||||
last-module)
|
||||
;; 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)
|
||||
(dolist (module-files modules)
|
||||
(cl-incf i)
|
||||
(dolist (target (cdr module-files))
|
||||
(let ((elc-file (byte-compile-dest-file target)))
|
||||
(cl-incf
|
||||
(if (and recompile-p (not (file-newer-than-file-p target elc-file)))
|
||||
total-noop
|
||||
(pcase (if (not (doom-file-cookie-p target "if" t))
|
||||
'no-byte-compile
|
||||
(unless (equal last-module (car module-files))
|
||||
(print! (success "(% 3d/%d) Compiling %s")
|
||||
i total-modules
|
||||
(if-let (m (caar module-files))
|
||||
(format "%s %s module..." m (cdar module-files))
|
||||
(format "%d stand alone elisp files..."
|
||||
(length (cdr module-files))))
|
||||
(caar module-files) (cdar module-files))
|
||||
(setq last-module (car module-files)))
|
||||
(if verbose-p
|
||||
(byte-compile-file target)
|
||||
(quiet! (byte-compile-file target))))
|
||||
(`no-byte-compile
|
||||
(doom-log "(% 3d/%d) Ignored %s" i total-modules target)
|
||||
total-noop)
|
||||
(`nil
|
||||
(print! (error "(% 3d/%d) Failed to compile %s")
|
||||
i total-modules (relpath target))
|
||||
total-fail)
|
||||
(_ total-ok)))))))
|
||||
(print! (class (if (= total-fail 0) 'success 'warn)
|
||||
"%s %d/%d file(s) (%d ignored)")
|
||||
(if recompile-p "Recompiled" "Byte-compiled")
|
||||
total-ok total-files
|
||||
total-noop)
|
||||
(= total-fail 0))
|
||||
((debug error)
|
||||
(print! (error "There were breaking errors.\n\n%s")
|
||||
"Reverting changes...")
|
||||
(signal 'doom-error (list 'byte-compile e))))))))
|
||||
|
||||
(defun doom-compile--ignore-file-p (path)
|
||||
(let ((filename (file-name-nondirectory path)))
|
||||
(or (not (equal (file-name-extension path) "el"))
|
||||
(member filename (list "packages.el" "doctor.el"))
|
||||
(string-prefix-p "." filename)
|
||||
(string-prefix-p "test-" filename)
|
||||
(string-prefix-p "flycheck_" filename)
|
||||
(string-suffix-p ".example.el" filename))))
|
||||
|
||||
(defun doom-compile-clean ()
|
||||
"Delete all the compiled elc files in your Emacs configuration and private
|
||||
module. This does not include your byte-compiled, third party packages.'"
|
||||
(require 'doom-modules)
|
||||
(print! (start "Cleaning .elc files"))
|
||||
(print-group!
|
||||
(cl-loop with default-directory = doom-emacs-dir
|
||||
with success = 0
|
||||
with esc = (if init-file-debug "" "\033[1A")
|
||||
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 "\033[KDeleted %s%s") (relpath path) esc)
|
||||
and do (cl-incf success)
|
||||
finally do
|
||||
(print! (if (> success 0)
|
||||
(success "\033[K%d elc files deleted" success)
|
||||
(item "\033[KNo elc files to clean"))))
|
||||
t))
|
||||
|
||||
(provide 'doom-cli-compile)
|
||||
;;; compile.el ends here
|
||||
296
lisp/cli/doctor.el
Normal file
296
lisp/cli/doctor.el
Normal file
|
|
@ -0,0 +1,296 @@
|
|||
;;; lisp/cli/doctor.el --- userland heuristics and Emacs diagnostics -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
(defvar doom-doctor--warnings ())
|
||||
(defvar doom-doctor--errors ())
|
||||
|
||||
|
||||
;;
|
||||
;;; DSL
|
||||
|
||||
(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)))
|
||||
|
||||
(defmacro error! (&rest args)
|
||||
`(progn (unless inhibit-message (print! (error ,@args)))
|
||||
(push (format! (error ,@args)) doom-doctor--errors)))
|
||||
|
||||
(defmacro warn! (&rest args)
|
||||
`(progn (unless inhibit-message (print! (warn ,@args)))
|
||||
(push (format! (warn ,@args)) doom-doctor--warnings)))
|
||||
|
||||
(defmacro success! (&rest args)
|
||||
`(print! (green ,@args)))
|
||||
|
||||
(defmacro section! (&rest args)
|
||||
`(print! (bold (blue ,@args))))
|
||||
|
||||
(defmacro explain! (&rest args)
|
||||
`(print-group! (print! (fill (string-join (list ,@args) "\n")))))
|
||||
|
||||
|
||||
;;
|
||||
;;; 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."
|
||||
:benchmark nil
|
||||
(print! "The doctor will see you now...\n")
|
||||
|
||||
;; REVIEW Refactor me
|
||||
(print! (start "Checking your Emacs version..."))
|
||||
(print-group!
|
||||
(cond
|
||||
((string= ".50" (substring emacs-version -3))
|
||||
(error! "Emacs development version detected (%s)" emacs-version)
|
||||
;; There are 2 newlines between each item to fight against
|
||||
;; the (fill-region) call in `doom--output-autofill'
|
||||
(explain! "Doom supports this version, but you are using a development version of Emacs! "
|
||||
"Be prepared for possibly weekly breakages that\n"
|
||||
"\t- you will have to investigate yourself."
|
||||
"\t- might appear, or be solved, on any Emacs update."
|
||||
"\t- might depend subtly on upstream packages updates.\n"
|
||||
"You might need to unpin packages to get a fix for a specific commit of Emacs, "
|
||||
"and you should be ready to downgrade Emacs if something is just not fixable."))
|
||||
(EMACS29+
|
||||
(warn! "Emacs %s detected" emacs-version)
|
||||
(explain! "Doom supports this version, but you are living on the edge! "
|
||||
"Be prepared for breakages in future versions of Emacs."))
|
||||
((< emacs-major-version 27)
|
||||
(error! "Emacs %s detected, Doom only supports 27.1 and newer"
|
||||
emacs-version))))
|
||||
|
||||
(print! (start "Checking for Doom's prerequisites..."))
|
||||
(print-group!
|
||||
(if (not (executable-find "git"))
|
||||
(error! "Couldn't find git on your machine! Doom's package manager won't work.")
|
||||
(save-match-data
|
||||
(let* ((version
|
||||
(cdr (doom-call-process "git" "version")))
|
||||
(version
|
||||
(and (string-match "git version \\([0-9]+\\(?:\\.[0-9]+\\)\\{2\\}\\)" version)
|
||||
(match-string 1 version))))
|
||||
(if version
|
||||
(when (version< version "2.23")
|
||||
(error! "Git %s detected! Doom requires git 2.23 or newer!"
|
||||
version))
|
||||
(warn! "Cannot determine Git version. Doom requires git 2.23 or newer!")))))
|
||||
|
||||
(unless (executable-find "rg")
|
||||
(error! "Couldn't find the `rg' binary; this a hard dependecy for Doom, file searches may not work at all")))
|
||||
|
||||
(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 great Emacs features..."))
|
||||
(unless (functionp 'json-serialize)
|
||||
(warn! "Emacs was not built with native JSON support")
|
||||
(explain! "Users will see a substantial performance gain by building Emacs with "
|
||||
"jansson support (i.e. a native JSON library), particularly LSP users. "
|
||||
"You must install a prebuilt Emacs binary with this included, or compile "
|
||||
"Emacs with the --with-json option."))
|
||||
(when EMACS28+
|
||||
(unless NATIVECOMP
|
||||
(warn! "Emacs was not built with native compilation support")
|
||||
(explain! "Users will see a substantial performance gain by building Emacs with "
|
||||
"native compilation support, availible in emacs 28+."
|
||||
"You must install a prebuilt Emacs binary with this included, or compile "
|
||||
"Emacs with the --with-native-compilation option.")))
|
||||
|
||||
(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/"))
|
||||
(dir (if (file-directory-p xdg-dir)
|
||||
xdg-dir
|
||||
doom-dir)))
|
||||
(when (file-equal-p dir doom-emacs-dir)
|
||||
(print! (error "Doom was cloned to %S, not ~/.emacs.d or ~/.config/emacs"
|
||||
(path dir)))
|
||||
(explain! "Doom's source and your private Doom config have to live in separate directories. "
|
||||
"Putting them in the same directory (without changing the DOOMDIR environment "
|
||||
"variable) will cause errors on startup."))
|
||||
(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 doom-emacs-dir)
|
||||
|
||||
(print! (start "Checking for problematic git global settings..."))
|
||||
(if (executable-find "git")
|
||||
(when (zerop (car (doom-call-process "git" "config" "--global" "--get-regexp" "^url\\.git://github\\.com")))
|
||||
(warn! "Detected insteadOf rules in your global gitconfig.")
|
||||
(explain! "Doom's package manager heavily relies on git. In particular, many of its packages "
|
||||
"are hosted on github. Rewrite rules like these will break it:\n\n"
|
||||
" [url \"git://github.com\"]\n"
|
||||
" insteadOf = https://github.com\n\n"
|
||||
"Please remove them from your gitconfig or use a conditional includeIf rule to "
|
||||
"only apply your rewrites to specific repositories. See "
|
||||
"'https://git-scm.com/docs/git-config#_includes' for more information."))
|
||||
(error! "Couldn't find the `git' binary; this a hard dependecy for Doom!"))
|
||||
|
||||
(print! (start "Checking Doom Emacs..."))
|
||||
(condition-case-unless-debug ex
|
||||
(print-group!
|
||||
(let ((noninteractive nil)
|
||||
kill-emacs-query-functions
|
||||
kill-emacs-hook)
|
||||
(defvar doom-reloading-p nil)
|
||||
(require 'doom-start)
|
||||
(doom-initialize-packages))
|
||||
|
||||
(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 1024.0))
|
||||
(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"))
|
||||
|
||||
(require 'projectile)
|
||||
(when (projectile-project-root "~")
|
||||
(warn! "Your $HOME is recognized as a project root")
|
||||
(explain! "Emacs will assume $HOME is the root of any project living under $HOME. If this isn't\n"
|
||||
"desired, you will need to remove \".git\" from `projectile-project-root-files-bottom-up'\n"
|
||||
"(a variable), e.g.\n\n"
|
||||
" (after! projectile\n"
|
||||
" (setq projectile-project-root-files-bottom-up\n"
|
||||
" (remove \".git\" projectile-project-root-files-bottom-up)))"))
|
||||
|
||||
;; 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 (executable-find "fc-list"))
|
||||
(warn! "Warning: unable to detect fonts because fontconfig isn't installed")
|
||||
;; 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
|
||||
(let ((errors 0))
|
||||
(cl-destructuring-bind (status . output)
|
||||
(doom-call-process "fc-list" "" "file")
|
||||
(if (not (zerop status))
|
||||
(print! (error "There was an error running `fc-list'. Is fontconfig installed correctly?"))
|
||||
(insert (cdr (doom-call-process "fc-list" "" "file")))
|
||||
(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)))
|
||||
(when (> errors 0)
|
||||
(explain! "Some all-the-icons fonts were missing.\n\n"
|
||||
"You can install them by running `M-x all-the-icons-install-fonts' within Emacs.\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-doctor--errors
|
||||
doom-doctor--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 with doom-output-indent = 6
|
||||
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))
|
||||
(plist-member (doom-package-get name :recipe) :local-repo)
|
||||
(locate-library (symbol-name name))
|
||||
(doom-package-built-in-p name)
|
||||
(doom-package-installed-p name))
|
||||
do (print! (error "Missing emacs package: %S") 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-doctor--errors doom-doctor--warnings)
|
||||
(print-group!
|
||||
(print! (start (bold "%s %s")) (car key) (cdr key))
|
||||
(print! "%s" (string-join (append doom-doctor--errors doom-doctor--warnings) "\n")))
|
||||
(setq doom-local-errors doom-doctor--errors
|
||||
doom-local-warnings doom-doctor--warnings)))
|
||||
(appendq! doom-doctor--errors doom-local-errors)
|
||||
(appendq! doom-doctor--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
|
||||
(terpri)
|
||||
(dolist (msg (list (list doom-doctor--warnings "warning" 'yellow)
|
||||
(list doom-doctor--errors "error" 'red)))
|
||||
(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-doctor--errors doom-doctor--warnings)
|
||||
(success! "Everything seems fine, happy Emacs'ing!"))
|
||||
(exit! :pager? "+G"))
|
||||
|
||||
(provide 'doom-cli-doctor)
|
||||
;;; doctor.el ends here
|
||||
140
lisp/cli/env.el
Normal file
140
lisp/cli/env.el
Normal file
|
|
@ -0,0 +1,140 @@
|
|||
;;; lisp/cli/env.el --- envvar file generator -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
(defvar doom-env-file (doom-path doom-profile-data-dir "env")
|
||||
"The location of your envvar file, generated by `doom env`.
|
||||
|
||||
This file contains environment variables scraped from your shell environment,
|
||||
which is loaded at startup (if it exists). This is helpful if Emacs can't
|
||||
\(easily) be launched from the correct shell session (particularly for MacOS
|
||||
users).")
|
||||
|
||||
(defvar doom-env-deny
|
||||
'(;; Unix/shell state that shouldn't be persisted
|
||||
"^HOME$" "^\\(OLD\\)?PWD$" "^SHLVL$" "^PS1$" "^R?PROMPT$" "^TERM\\(CAP\\)?$"
|
||||
"^USER$" "^GIT_CONFIG" "^INSIDE_EMACS$"
|
||||
;; X server or services' variables that shouldn't be persisted
|
||||
"^DISPLAY$" "^DBUS_SESSION_BUS_ADDRESS$" "^XAUTHORITY$" "^XDG_SESSION_TYPE$"
|
||||
;; Windows+WSL envvars that shouldn't be persisted
|
||||
"^WSL_INTEROP$"
|
||||
;; ssh and gpg variables (likely to become stale)
|
||||
"^SSH_\\(AUTH_SOCK\\|AGENT_PID\\)$" "^\\(SSH\\|GPG\\)_TTY$"
|
||||
"^GPG_AGENT_INFO$"
|
||||
;; Internal Doom envvars
|
||||
"^DEBUG$" "^INSECURE$" "^\\(EMACS\\|DOOM\\)DIR$" "^__")
|
||||
"Environment variables to omit from envvar files.
|
||||
|
||||
Each string is a regexp, matched against variable names to omit from
|
||||
`doom-env-file'.")
|
||||
|
||||
(defvar doom-env-allow '()
|
||||
"Environment variables to include in envvar files.
|
||||
|
||||
This overrules `doom-env-deny'. Each string is a regexp, matched against
|
||||
variable names to omit from `doom-env-file'.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! env
|
||||
((allow-only ("--allow-all"))
|
||||
(deny-only ("--deny-all"))
|
||||
(output-file ("-o" path) "Write envvar file to non-standard PATH.")
|
||||
;; TODO (refresh? ("-r" "--refresh"))
|
||||
&multiple
|
||||
(rules ("-a" "--allow" "-d" "--deny" regexp) "Allow/deny envvars that match REGEXP"))
|
||||
"(Re)generates envvars file from your shell environment.
|
||||
|
||||
The envvars file is created by scraping the current 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 sync'.
|
||||
However, 'doom sync' 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 you least want to deal with it."
|
||||
(let ((env-file (doom-path (or output-file doom-env-file))))
|
||||
(with-temp-file env-file
|
||||
(setq-local coding-system-for-write 'utf-8-unix)
|
||||
(print! (start "%s envvars file")
|
||||
(if (file-exists-p env-file)
|
||||
"Regenerating"
|
||||
"Generating"))
|
||||
(print-group!
|
||||
(goto-char (point-min))
|
||||
(insert
|
||||
";; -*- mode: lisp-interaction; coding: utf-8-unix; -*-\n"
|
||||
";; ---------------------------------------------------------------------------\n"
|
||||
";; This file was auto-generated by `doom env'. It contains a list of environment\n"
|
||||
";; variables scraped from your default shell (based on your settings for \n"
|
||||
";; `doom-env-allow' and `doom-env-deny').\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 sync'. 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")
|
||||
;; We assume that this noninteractive session was spawned from the user's
|
||||
;; interactive shell, so simply dump `process-environment' to a file.
|
||||
;;
|
||||
;; This should be well-formatted, in case humans want to hand-modify it.
|
||||
(let* ((denylist (remq nil (append (if deny-only '(".")) (list allow-only) doom-env-deny)))
|
||||
(allowlist (remq nil (append (if allow-only '(".")) (list deny-only) doom-env-allow))))
|
||||
(dolist (rule rules)
|
||||
(push (cdr rule) (if (member (car rule) '("-a" "--allow"))
|
||||
allowlist
|
||||
denylist)))
|
||||
(insert "(")
|
||||
(dolist (env (get 'process-environment 'initial-value))
|
||||
(catch 'skip
|
||||
(let* ((var (car (split-string env "=")))
|
||||
(pred (doom-rpartial #'string-match-p var)))
|
||||
(when (seq-find pred denylist)
|
||||
(if (seq-find pred allowlist)
|
||||
(doom-log "Whitelisted %s" var)
|
||||
(doom-log "Ignored %s" var)
|
||||
(throw 'skip t)))
|
||||
(insert (prin1-to-string env) "\n "))))
|
||||
(insert ")"))
|
||||
(print! (success "Generated %s") (path env-file))
|
||||
t))))
|
||||
|
||||
(defcli! (env (clear c)) ()
|
||||
"Deletes the default envvar file."
|
||||
(let ((env-file (abbreviate-file-name doom-env-file)))
|
||||
(unless (file-exists-p env-file)
|
||||
(user-error "No envvar file to delete: %s" env-file))
|
||||
(delete-file env-file)
|
||||
(print! (success "Deleted %s") (path env-file))))
|
||||
|
||||
(provide 'doom-cli-env)
|
||||
;;; env.el ends here
|
||||
466
lisp/cli/help.el
Normal file
466
lisp/cli/help.el
Normal file
|
|
@ -0,0 +1,466 @@
|
|||
;;; lisp/cli/help.el -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This file defines special commands that the Doom CLI will invoke when a
|
||||
;; command is passed with -?, --help, or --version. They can also be aliased to
|
||||
;; a sub-command to make more of its capabilities accessible to users, with:
|
||||
;;
|
||||
;; (defalias! (myscript (help h)) (:help))
|
||||
;;
|
||||
;; You can define your own command-specific help handlers, e.g.
|
||||
;;
|
||||
;; (defcli! (:help myscript subcommand) () ...)
|
||||
;;
|
||||
;; And it will be invoked instead of the generic one.
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
(defvar doom-help-commands '("%p %c {-?,--help}")
|
||||
"A list of help commands recognized for the running script.
|
||||
|
||||
Recognizes %p (for the prefix) and %c (for the active command).")
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! (:root :help)
|
||||
((localonly? ("-g" "--no-global") "Hide global options")
|
||||
(manpage? ("--manpage") "Generate in manpage format")
|
||||
(commands? ("--commands") "List all known commands")
|
||||
&multiple
|
||||
(sections ("--synopsis" "--subcommands" "--similar" "--envvars"
|
||||
"--postamble")
|
||||
"Show only the specified sections.")
|
||||
&context context
|
||||
&args command)
|
||||
"Show documentation for a Doom CLI command.
|
||||
|
||||
OPTIONS:
|
||||
--synopsis, --subcommands, --similar, --envvars, --postamble
|
||||
TODO"
|
||||
(doom-cli-load-all)
|
||||
(when (doom-cli-context-error context)
|
||||
(terpri))
|
||||
(let* ((command (cons (doom-cli-context-prefix context) command))
|
||||
(cli (doom-cli-get command t))
|
||||
(rcli (doom-cli-get cli))
|
||||
(fallbackcli (cl-loop with targets = (doom-cli--command-expand (butlast command) t)
|
||||
for cmd in (cons command targets)
|
||||
if (doom-cli-get cmd t)
|
||||
return it)))
|
||||
(cond (commands?
|
||||
(let ((cli (or cli (doom-cli-get (doom-cli-context-prefix context)))))
|
||||
(print! "Commands under '%s':\n%s"
|
||||
(doom-cli-command-string cli)
|
||||
(indent (doom-cli-help--render-commands
|
||||
(or (doom-cli-subcommands cli)
|
||||
(user-error "No commands found"))
|
||||
:prefix (doom-cli-command cli)
|
||||
:inline? t
|
||||
:docs? t)))))
|
||||
((null sections)
|
||||
(if (null cli)
|
||||
(signal 'doom-cli-command-not-found-error command)
|
||||
(doom-cli-help--print cli context manpage? localonly?)
|
||||
(exit! :pager?)))
|
||||
(t
|
||||
(dolist (section sections)
|
||||
(unless (equal section (car sections)) (terpri))
|
||||
(pcase section
|
||||
("--synopsis"
|
||||
(print! "%s" (doom-cli-help--render-synopsis
|
||||
(doom-cli-help--synopsis cli)
|
||||
"Usage: ")))
|
||||
("--subcommands"
|
||||
(print! "%s\n%s" (bold "Available commands:")
|
||||
(indent (doom-cli-help--render-commands
|
||||
(doom-cli-subcommands rcli 1)
|
||||
:prefix command
|
||||
:grouped? t
|
||||
:docs? t)
|
||||
doom-print-indent-increment)))
|
||||
("--similar"
|
||||
(unless command
|
||||
(user-error "No command specified"))
|
||||
(let ((similar (doom-cli-help-similar-commands command 0.4)))
|
||||
(print! "Similar commands:")
|
||||
(if (not similar)
|
||||
(print! (indent (warn "Can't find any!")))
|
||||
(dolist (command (seq-take similar 10))
|
||||
(print! (indent (item "(%d%%) %s"))
|
||||
(* (car command) 100)
|
||||
(doom-cli-command-string (cdr command)))))))
|
||||
("--envvars"
|
||||
(let* ((key "ENVIRONMENT VARIABLES")
|
||||
(clis (if command (doom-cli-find command) (hash-table-values doom-cli--table)))
|
||||
(clis (seq-remove #'doom-cli-alias clis))
|
||||
(clis (seq-filter (fn! (cdr (assoc key (doom-cli-docs %)))) clis))
|
||||
(clis (seq-group-by #'doom-cli-command clis)))
|
||||
(print! "List of environment variables for %s:\n" command)
|
||||
(if (null clis)
|
||||
(print! (indent "None!"))
|
||||
(dolist (group clis)
|
||||
(print! (bold "%s%s:"
|
||||
(doom-cli-command-string (car group))
|
||||
(if (doom-cli-fn (doom-cli-get (car group)))
|
||||
"" " *")))
|
||||
(dolist (cli (cdr group))
|
||||
(print! (indent "%s") (markup (cdr (assoc key (doom-cli-docs cli))))))))))
|
||||
("--postamble"
|
||||
(print! "See %s for documentation."
|
||||
(join (cl-loop with spec =
|
||||
`((?p . ,(doom-cli-context-prefix context))
|
||||
(?c . ,(doom-cli-command-string (cdr (doom-cli-command (or cli fallbackcli))))))
|
||||
for cmd in doom-help-commands
|
||||
for formatted = (trim (format-spec cmd spec))
|
||||
collect (replace-regexp-in-string
|
||||
" +" " " (format "'%s'" formatted)))
|
||||
" or ")))))))))
|
||||
|
||||
(defcli! (:root :version)
|
||||
((simple? ("--simple"))
|
||||
&context context)
|
||||
"Show installed versions of Doom, Doom modules, and Emacs."
|
||||
(doom/version)
|
||||
(unless simple?
|
||||
(terpri)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents (doom-path doom-emacs-dir "LICENSE"))
|
||||
(re-search-forward "^Copyright (c) ")
|
||||
(print! "%s\n" (trim (thing-at-point 'line t)))
|
||||
(print! (p "Doom Emacs uses the MIT license and is provided without warranty "
|
||||
"of any kind. You may redistribute and modify copies if "
|
||||
"given proper attribution. See the LICENSE file for details.")))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(defun doom-cli-help (cli)
|
||||
"Return an alist of documentation summarizing CLI (a `doom-cli')."
|
||||
(let* ((rcli (doom-cli-get cli))
|
||||
(docs (doom-cli-docs rcli)))
|
||||
`((command . ,(doom-cli-command-string cli))
|
||||
(summary . ,(or (cdr (assoc "SUMMARY" docs)) "TODO"))
|
||||
(description . ,(or (cdr (assoc "MAIN" docs)) "TODO"))
|
||||
(synopsis . ,(doom-cli-help--synopsis cli))
|
||||
(arguments . ,(doom-cli-help--arguments rcli))
|
||||
(options . ,(doom-cli-help--options rcli))
|
||||
(commands . ,(doom-cli-subcommands cli 1))
|
||||
(sections . ,(seq-filter #'cdr (cddr docs))))))
|
||||
|
||||
(defun doom-cli-help-similar-commands (command &optional maxscore)
|
||||
"Return N commands that are similar to COMMAND."
|
||||
(seq-take-while
|
||||
(fn! (>= (car %) (or maxscore 0.0)))
|
||||
(seq-sort-by
|
||||
#'car #'>
|
||||
(cl-loop with prefix = (seq-find #'doom-cli-get (nreverse (doom-cli--command-expand command t)))
|
||||
with input = (doom-cli-command-string (cdr (doom-cli--command command t)))
|
||||
for command in (hash-table-keys doom-cli--table)
|
||||
if (doom-cli-fn (doom-cli-get command))
|
||||
if (equal prefix (seq-take command (length prefix)))
|
||||
collect (cons (doom-cli-help--similarity
|
||||
input (doom-cli-command-string (cdr command)))
|
||||
command)))))
|
||||
|
||||
(defun doom-cli-help--similarity (s1 s2)
|
||||
;; Ratcliff-Obershelp similarity
|
||||
(let* ((s1 (downcase s1))
|
||||
(s2 (downcase s2))
|
||||
(s1len (length s1))
|
||||
(s2len (length s2)))
|
||||
(if (or (zerop s1len)
|
||||
(zerop s2len))
|
||||
0.0
|
||||
(/ (let ((i 0) (j 0) (score 0) jlast)
|
||||
(while (< i s1len)
|
||||
(unless jlast (setq jlast j))
|
||||
(if (and (< j s2len)
|
||||
(= (aref s1 i) (aref s2 j)))
|
||||
(progn (cl-incf score)
|
||||
(cl-incf i)
|
||||
(cl-incf j))
|
||||
(setq m 0)
|
||||
(cl-incf j)
|
||||
(when (>= j s2len)
|
||||
(setq j (or jlast j)
|
||||
jlast nil)
|
||||
(cl-incf i))))
|
||||
(* 2.0 score))
|
||||
(+ (length s1)
|
||||
(length s2))))))
|
||||
|
||||
;;; Help: printers
|
||||
;; TODO Parameterize optional args with `cl-defun'
|
||||
(defun doom-cli-help--print (cli context &optional manpage? noglobal?)
|
||||
"Write CLI's documentation in a manpage-esque format to stdout."
|
||||
(let-alist (doom-cli-help cli)
|
||||
(let* ((alist
|
||||
`(,@(if manpage?
|
||||
`((nil . ,(let* ((title (cadr (member "--load" command-line-args)))
|
||||
(width (floor (/ (- (doom-cli-context-width context)
|
||||
(length title))
|
||||
2.0))))
|
||||
;; FIXME Who am I fooling?
|
||||
(format (format "%%-%ds%%s%%%ds" width width)
|
||||
"DOOM(1)" title "DOOM(1)")))
|
||||
("NAME" . ,(concat .command " - " .summary))
|
||||
("SYNOPSIS" . ,(doom-cli-help--render-synopsis .synopsis nil t))
|
||||
("DESCRIPTION" . ,.description))
|
||||
`((nil . ,(doom-cli-help--render-synopsis .synopsis "Usage: "))
|
||||
(nil . ,(string-join (seq-remove #'string-empty-p (list .summary .description))
|
||||
"\n\n"))))
|
||||
("ARGUMENTS" . ,(doom-cli-help--render-arguments .arguments))
|
||||
("COMMANDS"
|
||||
. ,(doom-cli-help--render-commands
|
||||
.commands :prefix (doom-cli-command cli) :grouped? t :docs? t))
|
||||
("OPTIONS"
|
||||
. ,(doom-cli-help--render-options
|
||||
(if (or (not (doom-cli-fn cli)) noglobal?)
|
||||
`(,(assq 'local .options))
|
||||
.options)
|
||||
cli))))
|
||||
(command (doom-cli-command cli)))
|
||||
(letf! (defun printsection (section)
|
||||
(print! "%s\n"
|
||||
(if (null section)
|
||||
(dark "TODO")
|
||||
(markup
|
||||
(format-spec
|
||||
section `((?p . ,(car command))
|
||||
(?c . ,(doom-cli-command-string (cdr command))))
|
||||
'ignore)))))
|
||||
(pcase-dolist (`(,label . ,contents) alist)
|
||||
(when (and contents (not (string-blank-p contents)))
|
||||
(when label
|
||||
(print! (bold "%s%s") label (if manpage? "" ":")))
|
||||
(print-group-if! label (printsection contents))))
|
||||
(pcase-dolist (`(,label . ,contents) .sections)
|
||||
(when (and contents (not (assoc label alist)))
|
||||
(print! (bold "%s:") label)
|
||||
(print-group! (printsection contents))))))))
|
||||
|
||||
;;; Help: synopsis
|
||||
(defun doom-cli-help--synopsis (cli &optional all-options?)
|
||||
(let* ((rcli (doom-cli-get cli))
|
||||
(opts (doom-cli-help--options rcli))
|
||||
(opts (mapcar #'car (if all-options? (mapcan #'cdr opts) (alist-get 'local opts))))
|
||||
(opts (cl-loop for opt in opts
|
||||
for args = (cdar opt)
|
||||
for switches = (mapcar #'car opt)
|
||||
for multi? = (member "..." args)
|
||||
if args
|
||||
collect (format (if multi? "[%s %s]..." "[%s %s]")
|
||||
(string-join switches "|")
|
||||
(string-join (remove "..." args) "|"))
|
||||
else collect (format "[%s]" (string-join switches "|"))))
|
||||
(args (doom-cli-arguments rcli))
|
||||
(subcommands? (doom-cli-subcommands rcli 1 :predicate? t)))
|
||||
`((command . ,(doom-cli-command cli))
|
||||
(options ,@opts)
|
||||
(required ,@(mapcar (fn! (upcase (format "`%s'" %))) (if subcommands? '(command) (alist-get '&required args))))
|
||||
(optional ,@(mapcar (fn! (upcase (format "[`%s']" %)))(alist-get '&optional args)))
|
||||
(rest ,@(mapcar (fn! (upcase (format "[`%s'...]" %))) (if subcommands? '(args) (alist-get '&args args)))))))
|
||||
|
||||
(defun doom-cli-help--render-synopsis (synopsis &optional prefix)
|
||||
(let-alist synopsis
|
||||
(let ((doom-print-indent 0)
|
||||
(prefix (or prefix ""))
|
||||
(command (doom-cli-command-string .command)))
|
||||
(string-trim-right
|
||||
(format! "%s\n\n"
|
||||
(fill (concat (bold prefix)
|
||||
(format "%s " command)
|
||||
(markup
|
||||
(join (append .options
|
||||
(and .options
|
||||
(or .required
|
||||
.optional
|
||||
.rest)
|
||||
(list (dark "[--]")))
|
||||
.required
|
||||
.optional
|
||||
.rest))))
|
||||
80 (1+ (length (concat prefix command)))))))))
|
||||
|
||||
;;; Help: arguments
|
||||
(defun doom-cli-help--arguments (cli &optional all?)
|
||||
(doom-cli-help--parse-docs (doom-cli-find cli t) "ARGUMENTS"))
|
||||
|
||||
(defun doom-cli-help--render-arguments (arguments)
|
||||
(mapconcat (lambda (arg)
|
||||
(format! "%-20s\n%s"
|
||||
(underscore (car arg))
|
||||
(indent (if (equal (cdr arg) "TODO")
|
||||
(dark (cdr arg))
|
||||
(cdr arg))
|
||||
doom-print-indent-increment)))
|
||||
arguments
|
||||
"\n"))
|
||||
|
||||
;;; Help: commands
|
||||
(cl-defun doom-cli-help--render-commands (commands &key prefix grouped? docs? (inline? t))
|
||||
(with-temp-buffer
|
||||
(let* ((doom-print-indent 0)
|
||||
(commands (seq-group-by (fn! (if grouped? (doom-cli-prop (doom-cli-get % t) :group))) (nreverse commands)))
|
||||
(toplevel (assq nil commands))
|
||||
(rest (remove toplevel commands))
|
||||
(drop (if prefix (length prefix) 0))
|
||||
(minwidth
|
||||
(apply
|
||||
#'max (or (cl-loop for cmd in (apply #'append (mapcar #'cdr commands))
|
||||
for cmd = (seq-drop cmd drop)
|
||||
collect (length (doom-cli-command-string cmd)))
|
||||
(list 15))))
|
||||
(ellipsis (doom-print--style 'dark " […]"))
|
||||
(ellipsislen (- (length ellipsis) (if (eq doom-print-backend 'ansi) 2 4))))
|
||||
(dolist (group (cons toplevel rest))
|
||||
(let ((label (if (car-safe group) (cdr commands))))
|
||||
(when label
|
||||
(insert! ((bold "%s:") (car group)) "\n"))
|
||||
(print-group-if! label
|
||||
(dolist (command (cdr group))
|
||||
(let* ((cli (doom-cli-get command t))
|
||||
(rcli (doom-cli-get command))
|
||||
(summary (doom-cli-short-docs rcli))
|
||||
(subcommands? (doom-cli-subcommands cli 1 :predicate? t)))
|
||||
(insert! ((format "%%-%ds%%s%%s"
|
||||
(+ (- minwidth doom-print-indent)
|
||||
doom-print-indent-increment
|
||||
(if subcommands? ellipsislen 0)))
|
||||
(concat (doom-cli-command-string (seq-drop command drop))
|
||||
(if subcommands? ellipsis))
|
||||
(if inline? " " "\n")
|
||||
(indent (if (and (doom-cli-alias cli)
|
||||
(not (doom-cli-type rcli)))
|
||||
(dark "-> %s" (doom-cli-command-string cli))
|
||||
(when docs?
|
||||
(if summary (markup summary) (dark "TODO"))))))
|
||||
"\n")))
|
||||
(when (cdr rest)
|
||||
(insert "\n")))))
|
||||
(string-trim-right (buffer-string)))))
|
||||
|
||||
;;; Help: options
|
||||
(defun doom-cli-help--options (cli &optional noformatting?)
|
||||
"Return an alist summarizing CLI's options.
|
||||
|
||||
The alist's CAR are lists of formatted switches plus their arguments, e.g.
|
||||
'((\"`--foo'\" \"`BAR'\") ...). Their CDR is their formatted documentation."
|
||||
(let* ((docs (doom-cli-help--parse-docs (doom-cli-find cli t) "OPTIONS"))
|
||||
(docs (mapcar (fn! (cons (split-string (car %) ", ")
|
||||
(cdr %)))
|
||||
docs))
|
||||
(strfmt (if noformatting? "%s" "`%s'"))
|
||||
local-options
|
||||
global-options
|
||||
seen)
|
||||
(dolist (neighbor (nreverse (doom-cli-find cli)))
|
||||
(dolist (option (doom-cli-options neighbor))
|
||||
(when-let* ((switches (cl-loop for sw in (doom-cli-option-switches option)
|
||||
if (and (doom-cli-option-flag-p option)
|
||||
(string-prefix-p "--" sw))
|
||||
collect (format "--[no-]%s" (substring sw 2))
|
||||
else collect sw))
|
||||
(switches (seq-difference switches seen)))
|
||||
(dolist (switch switches) (push switch seen))
|
||||
(push (cons (cl-loop for switch in switches
|
||||
if (doom-cli-option-arguments option)
|
||||
collect (cons (format strfmt switch)
|
||||
(append (doom-cli-help--parse-args it noformatting?)
|
||||
(when (doom-cli-option-multiple-p option)
|
||||
(list "..."))))
|
||||
else collect (list (format strfmt switch)))
|
||||
(string-join
|
||||
(or (delq
|
||||
nil (cons (when-let (docs (doom-cli-option-docs option))
|
||||
(concat docs "."))
|
||||
(cl-loop for (flags . docs) in docs
|
||||
unless (equal (seq-difference flags switches) flags)
|
||||
collect docs)))
|
||||
'("TODO"))
|
||||
"\n\n"))
|
||||
(if (equal (doom-cli-command neighbor)
|
||||
(doom-cli-command cli))
|
||||
local-options
|
||||
global-options)))))
|
||||
`((local . ,(nreverse local-options))
|
||||
(global . ,(nreverse global-options)))))
|
||||
|
||||
(defun doom-cli-help--render-options (options &optional cli)
|
||||
(let ((doom-print-indent 0)
|
||||
(local (assq 'local options))
|
||||
(global (assq 'global options)))
|
||||
(when (or (cdr local) (cdr global))
|
||||
(letf! (defun printopts (opts)
|
||||
(pcase-dolist (`(,switches . ,docs) (cdr opts))
|
||||
(let (multiple?)
|
||||
(insert!
|
||||
("%s%s\n%s"
|
||||
(mapconcat
|
||||
(fn! (when (member "..." (cdr %))
|
||||
(setq multiple? t))
|
||||
(string-trim-right
|
||||
(format "%s %s"
|
||||
(doom-print--cli-markup (car %))
|
||||
(doom-print--cli-markup
|
||||
(string-join (remove "..." (cdr %)) "|")))))
|
||||
switches
|
||||
", ")
|
||||
(if multiple? ", ..." "")
|
||||
(indent (fill (markup docs)) doom-print-indent-increment))
|
||||
"\n\n"))))
|
||||
(with-temp-buffer
|
||||
(if (null (cdr local))
|
||||
(insert (if global "This command has no local options.\n" "") "\n")
|
||||
(printopts local))
|
||||
(when (cdr global)
|
||||
(insert! ((bold "Global options:\n")))
|
||||
(print-group! (printopts global)))
|
||||
(string-trim-right (buffer-string)))))))
|
||||
|
||||
;;; Help: internal
|
||||
(defun doom-cli-help--parse-args (args &optional noformatting?)
|
||||
(cl-loop for arg in args
|
||||
if (listp arg)
|
||||
collect (string-join (doom-cli-help--parse-args arg noformatting?) "|")
|
||||
else if (symbolp arg)
|
||||
collect (format (if noformatting? "%s" "`%s'") (upcase (symbol-name arg)))
|
||||
else collect arg))
|
||||
|
||||
(defun doom-cli-help--parse-docs (cli-list section-name)
|
||||
(cl-check-type section-name string)
|
||||
(let (alist)
|
||||
(dolist (cli cli-list (nreverse alist))
|
||||
(when-let (section (cdr (assoc section-name (doom-cli-docs cli))))
|
||||
(with-temp-buffer
|
||||
(save-excursion (insert section))
|
||||
(let ((lead (current-indentation))
|
||||
(buffer (current-buffer)))
|
||||
(while (not (eobp))
|
||||
(let ((heading (string-trim (buffer-substring (point-at-bol) (point-at-eol))))
|
||||
(beg (point-at-bol 2))
|
||||
end)
|
||||
(forward-line 1)
|
||||
(while (and (not (eobp))
|
||||
(/= (current-indentation) lead)
|
||||
(forward-line 1)))
|
||||
(setf (alist-get heading alist nil nil #'equal)
|
||||
(string-join
|
||||
(delq
|
||||
nil (list (alist-get heading alist nil nil #'equal)
|
||||
(let ((end (point)))
|
||||
(with-temp-buffer
|
||||
(insert-buffer-substring buffer beg end)
|
||||
(goto-char (point-min))
|
||||
(indent-rigidly (point-min) (point-max) (- (current-indentation)))
|
||||
(string-trim-right (buffer-string))))))
|
||||
"\n\n"))))))))))
|
||||
|
||||
(provide 'doom-cli-help)
|
||||
;;; help.el ends here
|
||||
34
lisp/cli/info.el
Normal file
34
lisp/cli/info.el
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
;;; lisp/cli/info.el --- information about your Doom install -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
;; None yet!
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! info
|
||||
((format ("--lisp" "--json") "What format to dump info into")
|
||||
&context context)
|
||||
"Print detailed information about your config for bug reports."
|
||||
(with-temp-buffer
|
||||
(pcase format
|
||||
("--json"
|
||||
(require 'json)
|
||||
(insert (json-encode (doom-info)))
|
||||
(json-pretty-print-buffer))
|
||||
("--lisp"
|
||||
(pp (doom-info)))
|
||||
(_
|
||||
(insert (doom-info-string
|
||||
(if (doom-cli-context-pipe-p context :out t)
|
||||
72
|
||||
(doom-cli-context-width context))))))
|
||||
(print! "%s" (string-trim-right (buffer-string)))))
|
||||
|
||||
(provide 'doom-cli-info)
|
||||
;;; info.el ends here
|
||||
132
lisp/cli/install.el
Normal file
132
lisp/cli/install.el
Normal file
|
|
@ -0,0 +1,132 @@
|
|||
;;; lisp/cli/install.el --- Doom Emacs install wizard -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
(load! "packages")
|
||||
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
;; None yet!
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! ((install i))
|
||||
(&flags
|
||||
(config? ("--config" :yes) "Create `$DOOMDIR' or dummy files therein?")
|
||||
(envfile? ("--env" :yes) "(Re)generate an envvars file? (see `$ doom help env`)")
|
||||
(install? ("--install" :yes) "Auto-install packages?")
|
||||
(fonts? ("--fonts" :yes) "Install (or prompt to install) all-the-icons fonts?")
|
||||
(hooks? ("--hooks" :yes) "Deploy Doom's git hooks to itself?")
|
||||
&context context)
|
||||
"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/templates/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.
|
||||
|
||||
Change `$DOOMDIR' with the `--doomdir' option, e.g.
|
||||
|
||||
```
|
||||
$ doom --doomdir /other/doom/config install
|
||||
```"
|
||||
(print! (green "Installing Doom Emacs!\n"))
|
||||
(let ((default-directory doom-emacs-dir)
|
||||
(yes? (doom-cli-context-suppress-prompts-p context)))
|
||||
;; Create `doom-private-dir'
|
||||
(if (eq config? :no)
|
||||
(print! (warn "Not copying private config template, as requested"))
|
||||
;; Create DOOMDIR in ~/.config/doom if ~/.config/emacs exists.
|
||||
(when (and (not (file-directory-p doom-private-dir))
|
||||
(not (getenv "DOOMDIR")))
|
||||
(let ((xdg-config-dir (or (getenv "XDG_CONFIG_HOME") "~/.config")))
|
||||
(when (file-in-directory-p doom-emacs-dir xdg-config-dir)
|
||||
(setq doom-private-dir (expand-file-name "doom/" xdg-config-dir)))))
|
||||
|
||||
(if (file-directory-p doom-private-dir)
|
||||
(print! (item "Skipping %s (already exists)") (relpath doom-private-dir))
|
||||
(make-directory doom-private-dir 'parents)
|
||||
(print! (success "Created %s") (relpath doom-private-dir)))
|
||||
|
||||
;; Create init.el, config.el & packages.el
|
||||
(print-group!
|
||||
(mapc (lambda (file)
|
||||
(cl-destructuring-bind (filename . template) file
|
||||
(if (file-exists-p! filename doom-private-dir)
|
||||
(print! (item "Skipping %s (already exists)")
|
||||
(path filename))
|
||||
(print! (item "Creating %s%s") (relpath doom-private-dir) filename)
|
||||
(with-temp-file (doom-path doom-private-dir filename)
|
||||
(insert-file-contents template))
|
||||
(print! (success "Done!")))))
|
||||
`(("init.el" . ,(doom-path doom-emacs-dir "templates/init.example.el"))
|
||||
("config.el" . ,(doom-path doom-emacs-dir "templates/config.example.el"))
|
||||
("packages.el" . ,(doom-path doom-emacs-dir "templates/packages.example.el"))))))
|
||||
|
||||
;; 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-modules 'force 'no-config)
|
||||
|
||||
;; Ask if user would like an envvar file generated
|
||||
(if (eq envfile? :no)
|
||||
(print! (warn "Not generating envvars file, as requested"))
|
||||
(if (file-exists-p doom-env-file)
|
||||
(print! (item "Envvar file already exists, skipping"))
|
||||
(when (or yes? (y-or-n-p "Generate an envvar file? (see `doom help env` for details)"))
|
||||
(call! '(env)))))
|
||||
|
||||
;; Install Doom packages
|
||||
(if (eq install? :no)
|
||||
(print! (warn "Not installing plugins, as requested"))
|
||||
(print! "Installing plugins")
|
||||
(doom-packages-install))
|
||||
|
||||
(print! "Regenerating autoloads files")
|
||||
(doom-autoloads-reload)
|
||||
|
||||
(if (eq hooks? :no)
|
||||
(print! (warn "Not deploying commit-msg and pre-push git hooks, as requested"))
|
||||
(print! "Deploying commit-msg and pre-push git hooks")
|
||||
(print-group!
|
||||
(condition-case e
|
||||
(call! `(ci deploy-hooks ,@(if yes? '("--force"))))
|
||||
('user-error
|
||||
(print! (warn "%s") (error-message-string e))))))
|
||||
|
||||
(cond ((eq fonts? :no))
|
||||
(IS-WINDOWS
|
||||
(print! (warn "Doom cannot install all-the-icons' fonts on Windows!\n"))
|
||||
(print-group!
|
||||
(print!
|
||||
(concat "You'll have to do so manually:\n\n"
|
||||
" 1. Launch Doom Emacs\n"
|
||||
" 2. Execute 'M-x all-the-icons-install-fonts' to download the fonts\n"
|
||||
" 3. Open the download location in windows explorer\n"
|
||||
" 4. Open each font file to install them"))))
|
||||
((or yes? (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
|
||||
(insert-file-contents (doom-path doom-emacs-dir "templates/QUICKSTART_INTRO"))
|
||||
(print! "%s" (buffer-string)))))
|
||||
|
||||
(provide 'doom-cli-install)
|
||||
;;; install.el ends here
|
||||
63
lisp/cli/make.el
Normal file
63
lisp/cli/make.el
Normal file
|
|
@ -0,0 +1,63 @@
|
|||
;;; lisp/cli/make.el --- file generation commands -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
(load! "make/completions")
|
||||
;; (load! "make/docs")
|
||||
;; (load! "make/manpage")
|
||||
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
;; (defvar doom-make-codeowners ()
|
||||
;; "TODO")
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! make ()
|
||||
"(Re)Generate project files and boilerplate."
|
||||
:partial t)
|
||||
|
||||
;; TODO Finish and generalize me
|
||||
(defstub! (make codeowners) ()
|
||||
"TODO"
|
||||
(print! (start "Generating CODEOWNERS file"))
|
||||
(let ((codeowners (doom-path doom-emacs-dir ".github/CODEOWNERS")))
|
||||
(with-temp-file codeowners
|
||||
(insert-file-contents codeowners)
|
||||
(when (re-search-forward "^# Don't edit this by hand!" nil t)
|
||||
(goto-char (line-end-position))
|
||||
(delete-region (point) (point-max))
|
||||
(insert "\n")
|
||||
(dolist (path (cdr (doom-module-load-path (list doom-modules-dir))))
|
||||
(when (string-match "/modules/\\([^/]+\\)/\\([^/]+\\)/$" path)
|
||||
(insert (format "%-35s @doomemacs/maintainers @doomemacs/%s-%s\n"
|
||||
(concat (substring (match-string-no-properties 0 path) 1) "*")
|
||||
(match-string-no-properties 1 path)
|
||||
(match-string-no-properties 2 path)))))))))
|
||||
|
||||
;; TODO Finish me
|
||||
(defstub! (make changelog))
|
||||
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(defmacro doom-make--with-file (file &rest body)
|
||||
(declare (indent 1))
|
||||
`(let ((inhibit-read-only t))
|
||||
(with-current-buffer
|
||||
(or (get-file-buffer ,file)
|
||||
(find-file-noselect ,file))
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
,@body
|
||||
(when (buffer-modified-p)
|
||||
(save-buffer))))))
|
||||
|
||||
(provide 'doom-cli-make)
|
||||
;;; make.el ends here
|
||||
142
lisp/cli/make/completions.el
Normal file
142
lisp/cli/make/completions.el
Normal file
|
|
@ -0,0 +1,142 @@
|
|||
;;; lisp/cli/make/completions.el --- generate shell completion scripts -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
;; (defvar doom-make-completions-zsh-spec
|
||||
;; '(("FILE" . "_files"))
|
||||
;; "TODO")
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! (make completions)
|
||||
((shell ("--zsh" "--bash") "Generate a particular flavor of completion files (defaults to $SHELL)")
|
||||
;; TODO (outfile ("-o" "--outfile" file))
|
||||
&context context &args args)
|
||||
"Generate completion scripts for a Doom-CLI script."
|
||||
;; (unless outfile
|
||||
;; (user-error "No destination file specified"))
|
||||
(let ((shell (or shell (file-name-base (getenv "SHELL"))))
|
||||
;; TODO Allow this command to read other Doom binscripts, which will
|
||||
;; dump their `doom-cli--table' if __DOOMDUMP is set.
|
||||
;; (table (read (letenv! (("__DOOMDUMP" "1")) (apply #'sh! script-file args))))
|
||||
)
|
||||
(print!
|
||||
"%s" (pcase (string-remove-prefix "--" shell)
|
||||
("zsh" (doom-make-completions-zsh context nil))
|
||||
("bash" (doom-make-completions-bash context nil))
|
||||
(_ (user-error "No support for %S shell at this time" shell))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; ZSH Helpers
|
||||
|
||||
;; TODO Write to OUTFILE when specified
|
||||
(defun doom-make-completions-zsh (context _outfile)
|
||||
(let* ((cli (doom-cli-get context))
|
||||
(prefix (doom-cli-context-prefix context))
|
||||
(options (doom-cli-help--options cli t))
|
||||
(commands (doom-cli-subcommands (list prefix))))
|
||||
(with-temp-buffer
|
||||
(insert "#compdef " (doom-cli-context-prefix context) "\n\n"
|
||||
"_globalargs=(\n ")
|
||||
(doom-make-completions--zsh-insert-options
|
||||
(append '(((("--help") ("-?")) . "Show help documentation")
|
||||
((("--version")) . "Show version information"))
|
||||
(alist-get 'global options))
|
||||
"\n ")
|
||||
(insert "\n)\n\n")
|
||||
(doom-make-completions--zsh-insert-command '("doom"))
|
||||
(mapc #'doom-make-completions--zsh-insert-command commands)
|
||||
;; (insert "\n\n_doom")
|
||||
(buffer-string))
|
||||
;; (set-file-modes outfile #o755)
|
||||
;; outfile
|
||||
))
|
||||
|
||||
(defun doom-make-completions--zsh-insert-options (options &optional cr)
|
||||
;; FIXME Refactor, generalize, and parameterize this mess
|
||||
(dolist (option options)
|
||||
(let* ((switches (cl-loop for (sw . args) in (car option)
|
||||
if (string-prefix-p "--[no-]" sw)
|
||||
collect (cons (concat "--" (string-remove-prefix "--[no-]" sw)) args)
|
||||
and collect (cons (concat "--no-" (string-remove-prefix "--[no-]" sw)) args)
|
||||
else collect (cons sw args)))
|
||||
(args (remove "..." (cdr (car switches))))
|
||||
(argspec (cl-loop for arg in args
|
||||
concat
|
||||
(format ":%s:%s"
|
||||
(replace-regexp-in-string
|
||||
":" ";" (shell-quote-argument arg))
|
||||
(or (plist-get (cdr (assoc (intern-soft (downcase (car args)))
|
||||
doom-cli-option-arg-types))
|
||||
:zshcomp)
|
||||
""))))
|
||||
(multiple? (member "..." (cdr (car switches)))))
|
||||
(insert (format "%s%s%s"
|
||||
(if multiple?
|
||||
"\\*"
|
||||
(format "'(%s)'" (mapconcat #'car switches " ")))
|
||||
(if (cdr switches)
|
||||
(format
|
||||
"{%s}" (combine-and-quote-strings
|
||||
(cl-loop for (sw . _) in switches
|
||||
if (and args (string-prefix-p "--" sw))
|
||||
collect (concat (shell-quote-argument sw) "=")
|
||||
else collect (shell-quote-argument sw))
|
||||
","))
|
||||
(format "%s%s" (caar switches)
|
||||
(if (and args (string-prefix-p "--" (caar switches)))
|
||||
"=" "")))
|
||||
(format "'[%s]%s'"
|
||||
(replace-regexp-in-string "'" "''" (cdr option))
|
||||
(or argspec "")))
|
||||
(or cr "\n")))))
|
||||
|
||||
(defun doom-make-completions--zsh-insert-command (command)
|
||||
(let* ((commandstr (doom-cli-command-string command))
|
||||
(options (alist-get 'local (doom-cli-help--options (doom-cli-get command) t)))
|
||||
(subcommands (doom-cli-subcommands command 1)))
|
||||
(insert "_" (replace-regexp-in-string "[- ]" "_" commandstr) "() {\n"
|
||||
" local line state\n"
|
||||
" _arguments -s -S -C \"${_globalargs[@]}\" \\\n ")
|
||||
(doom-make-completions--zsh-insert-options options " \\\n ")
|
||||
(insert "\"1: :->cmds\" \"*::arg:->args\"\n"
|
||||
" case $state in\n"
|
||||
" cmds)\n"
|
||||
" _values \"" commandstr "\" \\\n "
|
||||
(string-join
|
||||
(cl-loop for command in subcommands
|
||||
unless (string-prefix-p ":" (car command))
|
||||
collect (format "'%s[%s]' "
|
||||
(car (last command))
|
||||
(or (doom-cli-short-docs (doom-cli-get command))
|
||||
"TODO")))
|
||||
" \\\n ")
|
||||
"\n ;;\n"
|
||||
" args)\n"
|
||||
" case $line[1] in\n "
|
||||
(string-join
|
||||
(cl-loop for command in subcommands
|
||||
unless (string-prefix-p ":" (car command))
|
||||
collect (format "%s) _%s ;; "
|
||||
(car (last command))
|
||||
(replace-regexp-in-string "[- ]" "_" (doom-cli-command-string command))))
|
||||
"\n ")
|
||||
"\n esac\n"
|
||||
" ;;\n"
|
||||
" esac\n"
|
||||
"}\n")))
|
||||
|
||||
|
||||
;;
|
||||
;;; Bash helpers
|
||||
|
||||
(defun doom-make-completions-bash (context _outfile)
|
||||
(user-error "Bash completion exporter hasn't been implemented yet!"))
|
||||
|
||||
;;; completions.el ends here
|
||||
813
lisp/cli/packages.el
Normal file
813
lisp/cli/packages.el
Normal file
|
|
@ -0,0 +1,813 @@
|
|||
;;; lisp/cli/packages.el --- package management commands -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
;; None yet!
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! (:before (build b purge p)) (&context context)
|
||||
(require 'comp nil t)
|
||||
(doom-initialize-core-packages))
|
||||
|
||||
;; DEPRECATED Replace with "doom sync --rebuild"
|
||||
(defcli! ((build b))
|
||||
((rebuild-p ("-r") "Only rebuild packages that need rebuilding")
|
||||
(jobs ("-j" "--jobs" num) "How many CPUs to use for native compilation"))
|
||||
"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)."
|
||||
:benchmark t
|
||||
(when jobs
|
||||
(setq native-comp-async-jobs-number (truncate jobs)))
|
||||
(when (doom-packages-build (not rebuild-p))
|
||||
(doom-autoloads-reload))
|
||||
t)
|
||||
|
||||
;; TODO Rename to "doom gc" and move to its own file
|
||||
(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")
|
||||
(noeln-p ("-e" "--no-eln") "Don't purge old ELN bytecode")
|
||||
(noregraft-p ("-g" "--no-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."
|
||||
:benchmark t
|
||||
(straight-check-all)
|
||||
(when (doom-packages-purge
|
||||
(not noelpa-p)
|
||||
(not norepos-p)
|
||||
(not nobuilds-p)
|
||||
(not noregraft-p)
|
||||
(not noeln-p))
|
||||
(doom-autoloads-reload))
|
||||
t)
|
||||
|
||||
(defstub! rollback) ; TODO Implement me post-3.0
|
||||
|
||||
|
||||
;;
|
||||
;;; Library
|
||||
|
||||
;; FIXME Enforce naming conventions for all functions below
|
||||
|
||||
(defun doom-packages--same-commit-p (abbrev-ref ref)
|
||||
(and (stringp abbrev-ref)
|
||||
(stringp ref)
|
||||
(string-match-p (concat "^" (regexp-quote abbrev-ref))
|
||||
ref)))
|
||||
|
||||
(defun doom-packages--abbrev-commit (commit &optional full)
|
||||
(if full commit (substring commit 0 7)))
|
||||
|
||||
(defun doom-packages--commit-log-between (start-ref end-ref)
|
||||
(straight--process-with-result
|
||||
(straight--process-run
|
||||
"git" "log" "--oneline" "--no-merges"
|
||||
end-ref (concat "^" (regexp-quote start-ref)))
|
||||
(if success
|
||||
(string-trim-right (or stdout ""))
|
||||
(format "ERROR: Couldn't collect commit list because: %s" stderr))))
|
||||
|
||||
(defmacro doom-packages--straight-with (form &rest body)
|
||||
(declare (indent 1))
|
||||
`(let-alist
|
||||
(let* ((buffer (straight--process-buffer))
|
||||
(start (with-current-buffer buffer (point-max)))
|
||||
(retval ,form)
|
||||
(output (with-current-buffer buffer (buffer-substring start (point-max)))))
|
||||
(save-match-data
|
||||
(list (cons 'it retval)
|
||||
(cons 'stdout (substring-no-properties output))
|
||||
(cons 'success (if (string-match "\n+\\[Return code: \\([0-9-]+\\)\\]\n+" output)
|
||||
(string-to-number (match-string 1 output))))
|
||||
(cons 'output (string-trim output
|
||||
"^\\(\\$ [^\n]+\n\\)*\n+"
|
||||
"\n+\\[Return code: [0-9-]+\\]\n+")))))
|
||||
,@body))
|
||||
|
||||
(defun doom-packages--barf-if-incomplete ()
|
||||
(let ((straight-safe-mode t))
|
||||
(condition-case _ (straight-check-all)
|
||||
(error (user-error "Package state is incomplete. Run 'doom sync' first")))))
|
||||
|
||||
(defmacro doom-packages--with-recipes (recipes binds &rest body)
|
||||
(declare (indent 2))
|
||||
(let ((recipe-var (make-symbol "recipe"))
|
||||
(recipes-var (make-symbol "recipes")))
|
||||
`(let* ((,recipes-var ,recipes)
|
||||
(built ())
|
||||
(straight-use-package-pre-build-functions
|
||||
(cons (lambda (pkg &rest _) (cl-pushnew pkg built :test #'equal))
|
||||
straight-use-package-pre-build-functions)))
|
||||
(dolist (,recipe-var ,recipes-var (nreverse built))
|
||||
(cl-block nil
|
||||
(straight--with-plist (append (list :recipe ,recipe-var) ,recipe-var)
|
||||
,(doom-enlist binds)
|
||||
,@body))))))
|
||||
|
||||
(defvar doom-packages--cli-updated-recipes nil)
|
||||
(defun doom-packages--cli-recipes-update ()
|
||||
"Updates straight and recipe repos."
|
||||
(unless doom-packages--cli-updated-recipes
|
||||
(straight--make-build-cache-available)
|
||||
(print! (start "Updating recipe repos..."))
|
||||
(print-group!
|
||||
(doom-packages--with-recipes
|
||||
(delq
|
||||
nil (mapcar (doom-rpartial #'gethash straight--repo-cache)
|
||||
(mapcar #'symbol-name straight-recipe-repositories)))
|
||||
(recipe package type local-repo)
|
||||
(let ((esc (unless init-file-debug "\033[1A"))
|
||||
(ref (straight-vc-get-commit type local-repo))
|
||||
newref output)
|
||||
(print! (start "\033[KUpdating recipes for %s...%s") package esc)
|
||||
(doom-packages--straight-with (straight-vc-fetch-from-remote recipe)
|
||||
(when .it
|
||||
(setq output .output)
|
||||
(straight-merge-package package)
|
||||
(unless (equal ref (setq newref (straight-vc-get-commit type local-repo)))
|
||||
(print! (success "\033[K%s updated (%s -> %s)")
|
||||
package
|
||||
(doom-packages--abbrev-commit ref)
|
||||
(doom-packages--abbrev-commit newref))
|
||||
(unless (string-empty-p output)
|
||||
(print-group! (print! (item "%s" output))))))))))
|
||||
(setq straight--recipe-lookup-cache (make-hash-table :test #'eq)
|
||||
doom-packages--cli-updated-recipes t)))
|
||||
|
||||
(defvar doom-packages--eln-output-expected nil)
|
||||
|
||||
(defvar doom-packages--eln-output-path (car (bound-and-true-p native-comp-eln-load-path)))
|
||||
|
||||
(defun doom-packages--eln-file-name (file)
|
||||
"Return the short .eln file name corresponding to `file'."
|
||||
(concat comp-native-version-dir "/"
|
||||
(file-name-nondirectory
|
||||
(comp-el-to-eln-filename file))))
|
||||
|
||||
(defun doom-packages--eln-output-file (eln-name)
|
||||
"Return the expected .eln file corresponding to `eln-name'."
|
||||
(concat doom-packages--eln-output-path eln-name))
|
||||
|
||||
(defun doom-packages--eln-error-file (eln-name)
|
||||
"Return the expected .error file corresponding to `eln-name'."
|
||||
(concat doom-packages--eln-output-path eln-name ".error"))
|
||||
|
||||
(defun doom-packages--find-eln-file (eln-name)
|
||||
"Find `eln-name' on the `native-comp-eln-load-path'."
|
||||
(cl-some (lambda (eln-path)
|
||||
(let ((file (concat eln-path eln-name)))
|
||||
(when (file-exists-p file)
|
||||
file)))
|
||||
native-comp-eln-load-path))
|
||||
|
||||
(defun doom-packages--elc-file-outdated-p (file)
|
||||
"Check whether the corresponding .elc for `file' is outdated."
|
||||
(let ((elc-file (byte-compile-dest-file file)))
|
||||
;; NOTE Ignore missing elc files, they could be missing due to
|
||||
;; `no-byte-compile'. Rebuilding unnecessarily is expensive.
|
||||
(when (and (file-exists-p elc-file)
|
||||
(file-newer-than-file-p file elc-file))
|
||||
(doom-log "%s is newer than %s" file elc-file)
|
||||
t)))
|
||||
|
||||
(defun doom-packages--eln-file-outdated-p (file)
|
||||
"Check whether the corresponding .eln for `file' is outdated."
|
||||
(let* ((eln-name (doom-packages--eln-file-name file))
|
||||
(eln-file (doom-packages--find-eln-file eln-name))
|
||||
(error-file (doom-packages--eln-error-file eln-name)))
|
||||
(cond (eln-file
|
||||
(when (file-newer-than-file-p file eln-file)
|
||||
(doom-log "%s is newer than %s" file eln-file)
|
||||
t))
|
||||
((file-exists-p error-file)
|
||||
(when (file-newer-than-file-p file error-file)
|
||||
(doom-log "%s is newer than %s" file error-file)
|
||||
t))
|
||||
(t
|
||||
(doom-log "%s doesn't exist" eln-name)
|
||||
t))))
|
||||
|
||||
(defun doom-packages--native-compile-done-h (file)
|
||||
"Callback fired when an item has finished async compilation."
|
||||
(when file
|
||||
(let* ((eln-name (doom-packages--eln-file-name file))
|
||||
(eln-file (doom-packages--eln-output-file eln-name))
|
||||
(error-file (doom-packages--eln-error-file eln-name)))
|
||||
(if (file-exists-p eln-file)
|
||||
(doom-log "Compiled %s" eln-file)
|
||||
(make-directory (file-name-directory error-file) 'parents)
|
||||
(write-region "" nil error-file)
|
||||
(doom-log "Wrote %s" error-file)))))
|
||||
|
||||
(defun doom-packages--native-compile-jobs ()
|
||||
"How many async native compilation jobs are queued or in-progress."
|
||||
(if (featurep 'comp)
|
||||
(+ (length comp-files-queue)
|
||||
(comp-async-runnings))
|
||||
0))
|
||||
|
||||
(defun doom-packages--wait-for-native-compile-jobs ()
|
||||
"Wait for all pending async native compilation jobs."
|
||||
(cl-loop with previous = 0
|
||||
with timeout = 30
|
||||
with timer = 0
|
||||
for pending = (doom-packages--native-compile-jobs)
|
||||
while (not (zerop pending))
|
||||
if (/= previous pending) do
|
||||
(print! (start "\033[KNatively compiling %d files...\033[1A" pending))
|
||||
(setq previous pending
|
||||
timer 0)
|
||||
else do
|
||||
(let ((inhibit-message t))
|
||||
(if (> timer timeout)
|
||||
(cl-loop for file-name being each hash-key of comp-async-compilations
|
||||
for prc = (gethash file-name comp-async-compilations)
|
||||
unless (process-live-p prc)
|
||||
do (setq timer 0)
|
||||
and do (print! (warn "Native compilation of %S timed out" (path file-name)))
|
||||
and return (kill-process prc))
|
||||
(cl-incf timer 0.1))
|
||||
(sleep-for 0.1))))
|
||||
|
||||
(defun doom-packages--write-missing-eln-errors ()
|
||||
"Write .error files for any expected .eln files that are missing."
|
||||
(when NATIVECOMP
|
||||
(cl-loop for file in doom-packages--eln-output-expected
|
||||
for eln-name = (doom-packages--eln-file-name file)
|
||||
for eln-file = (doom-packages--eln-output-file eln-name)
|
||||
for error-file = (doom-packages--eln-error-file eln-name)
|
||||
unless (or (file-exists-p eln-file)
|
||||
(file-newer-than-file-p error-file file))
|
||||
do (make-directory (file-name-directory error-file) 'parents)
|
||||
(write-region "" nil error-file)
|
||||
(doom-log "Wrote %s" error-file))
|
||||
(setq doom-packages--eln-output-expected nil)))
|
||||
|
||||
(defun doom-packages--compile-site-files ()
|
||||
"Queue async compilation for all non-doom Elisp files."
|
||||
(when NATIVECOMP
|
||||
(cl-loop with paths = (cl-loop for path in load-path
|
||||
unless (string-prefix-p doom-local-dir path)
|
||||
collect path)
|
||||
for file in (doom-files-in paths :match "\\.el\\(?:\\.gz\\)?$")
|
||||
if (and (file-exists-p (byte-compile-dest-file file))
|
||||
(not (doom-packages--find-eln-file (doom-packages--eln-file-name file)))
|
||||
(not (cl-some (lambda (re)
|
||||
(string-match-p re file))
|
||||
native-comp-deferred-compilation-deny-list))) do
|
||||
(doom-log "Compiling %s" file)
|
||||
(native-compile-async file))))
|
||||
|
||||
(defun doom-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."
|
||||
(doom-initialize-packages)
|
||||
(print! (start "Installing packages..."))
|
||||
(let ((pinned (doom-package-pinned-list)))
|
||||
(print-group!
|
||||
(add-hook 'native-comp-async-cu-done-functions #'doom-packages--native-compile-done-h)
|
||||
(if-let (built
|
||||
(doom-packages--with-recipes (doom-package-recipe-list)
|
||||
(recipe package type local-repo)
|
||||
(unless (file-directory-p (straight--repos-dir local-repo))
|
||||
(doom-packages--cli-recipes-update))
|
||||
(condition-case-unless-debug e
|
||||
(let ((straight-use-package-pre-build-functions
|
||||
(cons (lambda (pkg &rest _)
|
||||
(when-let (commit (cdr (assoc pkg pinned)))
|
||||
(print! (item "Checked out %s: %s") pkg commit)))
|
||||
straight-use-package-pre-build-functions)))
|
||||
(straight-use-package (intern package))
|
||||
;; HACK Line encoding issues can plague repos with dirty
|
||||
;; worktree prompts when updating packages or "Local
|
||||
;; variables entry is missing the suffix" errors when
|
||||
;; installing them (see hlissner/doom-emacs#2637), so
|
||||
;; have git handle conversion by force.
|
||||
(when (and IS-WINDOWS (stringp local-repo))
|
||||
(let ((default-directory (straight--repos-dir local-repo)))
|
||||
(when (file-in-directory-p default-directory straight-base-dir)
|
||||
(straight--process-run "git" "config" "core.autocrlf" "true")))))
|
||||
(error
|
||||
(signal 'doom-package-error (list package e))))))
|
||||
(progn
|
||||
(doom-packages--compile-site-files)
|
||||
(when NATIVECOMP
|
||||
(doom-packages--wait-for-native-compile-jobs)
|
||||
(doom-packages--write-missing-eln-errors))
|
||||
(print! (success "\033[KInstalled %d packages") (length built)))
|
||||
(print! (item "No packages need to be installed"))
|
||||
nil))))
|
||||
|
||||
|
||||
(defun doom-packages-build (&optional force-p)
|
||||
"(Re)build all packages."
|
||||
(doom-initialize-packages)
|
||||
(print! (start "(Re)building %spackages...") (if force-p "all " ""))
|
||||
(print-group!
|
||||
(let ((straight-check-for-modifications
|
||||
(when (file-directory-p (straight--modified-dir))
|
||||
'(find-when-checking)))
|
||||
(straight--allow-find
|
||||
(and straight-check-for-modifications
|
||||
(executable-find straight-find-executable)
|
||||
t))
|
||||
(straight--packages-not-to-rebuild
|
||||
(or straight--packages-not-to-rebuild (make-hash-table :test #'equal)))
|
||||
(straight--packages-to-rebuild
|
||||
(or (if force-p :all straight--packages-to-rebuild)
|
||||
(make-hash-table :test #'equal)))
|
||||
(recipes (doom-package-recipe-list)))
|
||||
(add-hook 'native-comp-async-cu-done-functions #'doom-packages--native-compile-done-h)
|
||||
(unless force-p
|
||||
(straight--make-build-cache-available))
|
||||
(if-let (built
|
||||
(doom-packages--with-recipes recipes (package local-repo recipe)
|
||||
(unless force-p
|
||||
;; Ensure packages with outdated files/bytecode are rebuilt
|
||||
(let* ((build-dir (straight--build-dir package))
|
||||
(repo-dir (straight--repos-dir local-repo))
|
||||
(build (if (plist-member recipe :build)
|
||||
(plist-get recipe :build)
|
||||
t))
|
||||
(want-byte-compile
|
||||
(or (eq build t)
|
||||
(memq 'compile build)))
|
||||
(want-native-compile
|
||||
(or (eq build t)
|
||||
(memq 'native-compile build))))
|
||||
(and (eq (car-safe build) :not)
|
||||
(setq want-byte-compile (not want-byte-compile)
|
||||
want-native-compile (not want-native-compile)))
|
||||
(unless NATIVECOMP
|
||||
(setq want-native-compile nil))
|
||||
(and (or want-byte-compile want-native-compile)
|
||||
(or (file-newer-than-file-p repo-dir build-dir)
|
||||
(file-exists-p (straight--modified-dir (or local-repo package)))
|
||||
(cl-loop with outdated = nil
|
||||
for file in (doom-files-in build-dir :match "\\.el$" :full t)
|
||||
if (or (if want-byte-compile (doom-packages--elc-file-outdated-p file))
|
||||
(if want-native-compile (doom-packages--eln-file-outdated-p file)))
|
||||
do (setq outdated t)
|
||||
(when want-native-compile
|
||||
(push file doom-packages--eln-output-expected))
|
||||
finally return outdated))
|
||||
(puthash package t straight--packages-to-rebuild))))
|
||||
(straight-use-package (intern package))))
|
||||
(progn
|
||||
(doom-packages--compile-site-files)
|
||||
(when NATIVECOMP
|
||||
(doom-packages--wait-for-native-compile-jobs)
|
||||
(doom-packages--write-missing-eln-errors))
|
||||
;; HACK Every time you save a file in a package that straight tracks,
|
||||
;; it is recorded in ~/.emacs.d/.local/straight/modified/.
|
||||
;; Typically, straight will clean these up after rebuilding, but
|
||||
;; Doom's use-case circumnavigates that, leaving these files
|
||||
;; there and causing a rebuild of those packages each time `doom
|
||||
;; sync' or similar is run, so we clean it up ourselves:
|
||||
(delete-directory (straight--modified-dir) 'recursive)
|
||||
(print! (success "\033[KRebuilt %d package(s)") (length built)))
|
||||
(print! (item "No packages need rebuilding"))
|
||||
nil))))
|
||||
|
||||
|
||||
|
||||
(defun doom-packages-update ()
|
||||
"Updates packages."
|
||||
(doom-initialize-packages)
|
||||
(doom-packages--barf-if-incomplete)
|
||||
(doom-packages--cli-recipes-update)
|
||||
(let* ((repo-dir (straight--repos-dir))
|
||||
(pinned (doom-package-pinned-list))
|
||||
(recipes (doom-package-recipe-list))
|
||||
(packages-to-rebuild (make-hash-table :test 'equal))
|
||||
(repos-to-rebuild (make-hash-table :test 'equal))
|
||||
(total (length recipes))
|
||||
(esc (unless init-file-debug "\033[1A"))
|
||||
(i 0)
|
||||
errors)
|
||||
(print! (start "Updating packages (this may take a while)..."))
|
||||
(doom-packages--with-recipes recipes (recipe package type local-repo)
|
||||
(cl-incf i)
|
||||
(print-group!
|
||||
(unless (straight--repository-is-available-p recipe)
|
||||
(print! (error "(%d/%d) Couldn't find local repo for %s") i total package)
|
||||
(cl-return))
|
||||
(when (gethash local-repo repos-to-rebuild)
|
||||
(puthash package t packages-to-rebuild)
|
||||
(print! (success "(%d/%d) %s was updated indirectly (with %s)") i total package local-repo)
|
||||
(cl-return))
|
||||
(let ((default-directory (straight--repos-dir local-repo)))
|
||||
(unless (file-in-directory-p default-directory repo-dir)
|
||||
(print! (warn "(%d/%d) Skipping %s because it is local") i total package)
|
||||
(cl-return))
|
||||
(when (eq type 'git)
|
||||
(unless (file-exists-p ".git")
|
||||
(error "%S is not a valid repository" package)))
|
||||
(condition-case-unless-debug e
|
||||
(let ((ref (straight-vc-get-commit type local-repo))
|
||||
(target-ref
|
||||
(cdr (or (assoc local-repo pinned)
|
||||
(assoc package pinned))))
|
||||
commits
|
||||
output)
|
||||
(or (cond
|
||||
((not (stringp target-ref))
|
||||
(print! (start "\033[K(%d/%d) Fetching %s...%s") i total package esc)
|
||||
(doom-packages--straight-with (straight-vc-fetch-from-remote recipe)
|
||||
(when .it
|
||||
(straight-merge-package package)
|
||||
;; (condition-case e
|
||||
;; (straight-merge-package package)
|
||||
;; (wrong-type-argument
|
||||
;; (if (not (equal (cdr e) '(arrayp nil)))
|
||||
;; (signal (car e) (cdr e))
|
||||
;; (delete-directory (straight--build-dir local-repo) t)
|
||||
;; (straight-use-package (intern package)))))
|
||||
(setq target-ref (straight-vc-get-commit type local-repo))
|
||||
(setq output (doom-packages--commit-log-between ref target-ref)
|
||||
commits (length (split-string output "\n" t)))
|
||||
(or (not (doom-packages--same-commit-p target-ref ref))
|
||||
(cl-return)))))
|
||||
|
||||
((doom-packages--same-commit-p target-ref ref)
|
||||
(print! (item "\033[K(%d/%d) %s is up-to-date...%s") i total package esc)
|
||||
(cl-return))
|
||||
|
||||
((if (straight-vc-commit-present-p recipe target-ref)
|
||||
(print! (start "\033[K(%d/%d) Checking out %s (%s)...%s")
|
||||
i total package (doom-packages--abbrev-commit target-ref) esc)
|
||||
(print! (start "\033[K(%d/%d) Fetching %s...%s") i total package esc)
|
||||
(and (straight-vc-fetch-from-remote recipe)
|
||||
(straight-vc-commit-present-p recipe target-ref)))
|
||||
(straight-vc-check-out-commit recipe target-ref)
|
||||
(or (not (eq type 'git))
|
||||
(setq output (doom-packages--commit-log-between ref target-ref)
|
||||
commits (length (split-string output "\n" t))))
|
||||
(doom-packages--same-commit-p target-ref (straight-vc-get-commit type local-repo)))
|
||||
|
||||
((print! (start "\033[K(%d/%d) Re-cloning %s...") i total local-repo esc)
|
||||
(let ((repo (straight--repos-dir local-repo))
|
||||
(straight-vc-git-default-clone-depth 'full))
|
||||
(delete-directory repo 'recursive)
|
||||
(print-group!
|
||||
(straight-use-package (intern package) nil 'no-build))
|
||||
(prog1 (file-directory-p repo)
|
||||
(or (not (eq type 'git))
|
||||
(setq output (doom-packages--commit-log-between ref target-ref)
|
||||
commits (length (split-string output "\n" t))))))))
|
||||
(progn
|
||||
(print! (warn "\033[K(%d/%d) Failed to fetch %s")
|
||||
i total local-repo)
|
||||
(unless (string-empty-p output)
|
||||
(print-group! (print! (item "%s" output))))
|
||||
(cl-return)))
|
||||
(puthash local-repo t repos-to-rebuild)
|
||||
(puthash package t packages-to-rebuild)
|
||||
(print! (success "\033[K(%d/%d) %s: %s -> %s%s")
|
||||
i total local-repo
|
||||
(doom-packages--abbrev-commit ref)
|
||||
(doom-packages--abbrev-commit target-ref)
|
||||
(if (and (integerp commits) (> commits 0))
|
||||
(format " [%d commit(s)]" commits)
|
||||
""))
|
||||
(unless (string-empty-p output)
|
||||
(let ((lines (split-string output "\n")))
|
||||
(setq output
|
||||
(if (> (length lines) 20)
|
||||
(concat (string-join (cl-subseq (butlast lines 1) 0 20) "\n")
|
||||
"\n[...]")
|
||||
output)))
|
||||
(print-group! (print! "%s" (indent output 2)))))
|
||||
(user-error
|
||||
(signal 'user-error (error-message-string e)))
|
||||
(error
|
||||
(signal 'doom-package-error (list package e)))))))
|
||||
(print-group!
|
||||
(princ "\033[K")
|
||||
(if (hash-table-empty-p packages-to-rebuild)
|
||||
(ignore (print! (success "All %d packages are up-to-date") total))
|
||||
(straight--transaction-finalize)
|
||||
(let ((default-directory (straight--build-dir)))
|
||||
(mapc (doom-rpartial #'delete-directory 'recursive)
|
||||
(hash-table-keys packages-to-rebuild)))
|
||||
(print! (success "Updated %d package(s)")
|
||||
(hash-table-count packages-to-rebuild))
|
||||
(doom-packages-build)
|
||||
t))))
|
||||
|
||||
|
||||
;;; PURGE (for the emperor)
|
||||
(defun doom-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-packages--purge-builds (builds)
|
||||
(if (not builds)
|
||||
(prog1 0
|
||||
(print! (item "No builds to purge")))
|
||||
(print! (start "Purging straight builds..." (length builds)))
|
||||
(print-group!
|
||||
(length
|
||||
(delq nil (mapcar #'doom-packages--purge-build builds))))))
|
||||
|
||||
(cl-defun doom-packages--regraft-repo (repo)
|
||||
(unless repo
|
||||
(error "No repo specified for regrafting"))
|
||||
(let ((default-directory (straight--repos-dir repo)))
|
||||
(unless (file-directory-p ".git")
|
||||
(print! (warn "\033[Krepos/%s is not a git repo, skipping" repo))
|
||||
(cl-return))
|
||||
(unless (file-in-directory-p default-directory straight-base-dir)
|
||||
(print! (warn "\033[KSkipping repos/%s because it is local" repo))
|
||||
(cl-return))
|
||||
(let ((before-size (doom-directory-size default-directory)))
|
||||
(doom-call-process "git" "reset" "--hard")
|
||||
(doom-call-process "git" "clean" "-ffd")
|
||||
(if (not (zerop (car (doom-call-process "git" "replace" "--graft" "HEAD"))))
|
||||
(print! (item "\033[Krepos/%s is already compact\033[1A" repo))
|
||||
(doom-call-process "git" "reflog" "expire" "--expire=all" "--all")
|
||||
(doom-call-process "git" "gc" "--prune=now")
|
||||
(let ((after-size (doom-directory-size default-directory)))
|
||||
(if (equal after-size before-size)
|
||||
(print! (success "\033[Krepos/%s cannot be compacted further" repo))
|
||||
(print! (success "\033[KRegrafted repos/%s (from %0.1fKB to %0.1fKB)")
|
||||
repo before-size after-size)))))
|
||||
t))
|
||||
|
||||
(defun doom-packages--regraft-repos (repos)
|
||||
(if (not repos)
|
||||
(prog1 0
|
||||
(print! (item "No repos to regraft")))
|
||||
(print! (start "Regrafting %d repos..." (length repos)))
|
||||
(let ((before-size (doom-directory-size (straight--repos-dir))))
|
||||
(print-group!
|
||||
(prog1 (delq nil (mapcar #'doom-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-packages--purge-repo (repo)
|
||||
(let ((repo-dir (straight--repos-dir repo)))
|
||||
(when (file-directory-p repo-dir)
|
||||
(delete-directory repo-dir 'recursive)
|
||||
(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-packages--purge-repos (repos)
|
||||
(if (not repos)
|
||||
(prog1 0
|
||||
(print! (item "No repos to purge")))
|
||||
(print! (start "Purging straight repositories..."))
|
||||
(print-group!
|
||||
(length
|
||||
(delq nil (mapcar #'doom-packages--purge-repo repos))))))
|
||||
|
||||
(defun doom-packages--purge-elpa ()
|
||||
(require 'doom-packages)
|
||||
(let ((dirs (doom-files-in package-user-dir :type t :depth 0)))
|
||||
(if (not dirs)
|
||||
(prog1 0
|
||||
(print! (item "No ELPA packages to purge")))
|
||||
(print! (start "Purging ELPA packages..."))
|
||||
(dolist (path dirs (length dirs))
|
||||
(condition-case e
|
||||
(print-group!
|
||||
(if (file-directory-p path)
|
||||
(delete-directory path 'recursive)
|
||||
(delete-file path))
|
||||
(print! (success "Deleted %s") (filename path)))
|
||||
(error
|
||||
(print! (error "Failed to delete %s because: %s")
|
||||
(filename path)
|
||||
e)))))))
|
||||
|
||||
(defun doom-packages--purge-eln ()
|
||||
(if-let (dirs
|
||||
(cl-delete (expand-file-name comp-native-version-dir doom-packages--eln-output-path)
|
||||
(directory-files doom-packages--eln-output-path t "^[^.]" t)
|
||||
:test #'file-equal-p))
|
||||
(progn
|
||||
(print! (start "Purging old native bytecode..."))
|
||||
(print-group!
|
||||
(dolist (dir dirs)
|
||||
(print! (item "Deleting %S") (relpath dir doom-packages--eln-output-path))
|
||||
(delete-directory dir 'recursive))
|
||||
(print! (success "Purged %d directory(ies)" (length dirs))))
|
||||
(length dirs))
|
||||
(print! (item "No ELN directories to purge"))
|
||||
0))
|
||||
|
||||
(defun doom-packages-purge (&optional elpa-p builds-p repos-p regraft-repos-p eln-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)."
|
||||
(doom-initialize-packages)
|
||||
(doom-packages--barf-if-incomplete)
|
||||
(print! (start "Purging orphaned packages (for the emperor)..."))
|
||||
(cl-destructuring-bind (&optional builds-to-purge repos-to-purge repos-to-regraft)
|
||||
(let ((rdirs
|
||||
(and (or repos-p regraft-repos-p)
|
||||
(straight--directory-files (straight--repos-dir) nil nil 'sort))))
|
||||
(list (when builds-p
|
||||
(let ((default-directory (straight--build-dir)))
|
||||
(seq-filter #'file-directory-p
|
||||
(seq-remove (doom-rpartial #'gethash straight--profile-cache)
|
||||
(straight--directory-files default-directory nil nil 'sort)))))
|
||||
(when repos-p
|
||||
(seq-remove (doom-rpartial #'straight--checkhash straight--repo-cache)
|
||||
rdirs))
|
||||
(when regraft-repos-p
|
||||
(seq-filter (doom-rpartial #'straight--checkhash straight--repo-cache)
|
||||
rdirs))))
|
||||
(print-group!
|
||||
(delq
|
||||
nil (list
|
||||
(if (not builds-p)
|
||||
(ignore (print! (item "Skipping builds")))
|
||||
(and (/= 0 (doom-packages--purge-builds builds-to-purge))
|
||||
(straight-prune-build-cache)))
|
||||
(if (not elpa-p)
|
||||
(ignore (print! (item "Skipping elpa packages")))
|
||||
(/= 0 (doom-packages--purge-elpa)))
|
||||
(if (not repos-p)
|
||||
(ignore (print! (item "Skipping repos")))
|
||||
(/= 0 (doom-packages--purge-repos repos-to-purge)))
|
||||
(if (not regraft-repos-p)
|
||||
(ignore (print! (item "Skipping regrafting")))
|
||||
(doom-packages--regraft-repos repos-to-regraft))
|
||||
(when NATIVECOMP
|
||||
(if (not eln-p)
|
||||
(ignore (print! (item "Skipping native bytecode")))
|
||||
(doom-packages--purge-eln))))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Hacks
|
||||
|
||||
;; Straight was designed primarily for interactive use, in an interactive Emacs
|
||||
;; session, but Doom does its package management in the terminal. Some things
|
||||
;; must be modified get straight to behave and improve its UX for our users.
|
||||
|
||||
(defvar doom-cli--straight-auto-options
|
||||
'(("has diverged from"
|
||||
. "^Reset [^ ]+ to branch")
|
||||
("but recipe specifies a URL of"
|
||||
. "Delete remote \"[^\"]+\", re-create it with correct URL")
|
||||
("has a merge conflict:"
|
||||
. "^Abort merge$")
|
||||
("has a dirty worktree:"
|
||||
. "^Discard changes$")
|
||||
("^In repository \"[^\"]+\", [^ ]+ (on branch \"main\") is ahead of default branch \"master\""
|
||||
. "^Checkout branch \"master\"")
|
||||
("^In repository \"[^\"]+\", [^ ]+ (on branch \"[^\"]+\") is ahead of default branch \"[^\"]+\""
|
||||
. "^Checkout branch \"")
|
||||
("^In repository "
|
||||
. "^Reset branch \\|^Delete remote [^,]+, re-create it with correct URL"))
|
||||
"A list of regexps, mapped to regexps.
|
||||
|
||||
Their CAR is tested against the prompt, and CDR is tested against the presented
|
||||
option, and is used by `straight-vc-git--popup-raw' to select which option to
|
||||
recommend.
|
||||
|
||||
It may not be obvious to users what they should do for some straight prompts,
|
||||
so Doom will recommend the one that reverts a package back to its (or target)
|
||||
original state.")
|
||||
|
||||
;; FIXME Replace with a -j/--jobs option in 'doom sync' et co
|
||||
(defadvice! doom-cli--comp-use-all-cores-a (&rest _)
|
||||
"Default to using all cores, rather than half.
|
||||
Doom compiles packages ahead-of-time, in a dedicated noninteractive session, so
|
||||
it doesn't make sense to slack."
|
||||
:before #'comp-effective-async-max-jobs
|
||||
(setq comp-num-cpus (doom-system-cpus)))
|
||||
|
||||
;; HACK Remove dired & magit options from prompt, since they're inaccessible in
|
||||
;; noninteractive sessions.
|
||||
(advice-add #'straight-vc-git--popup-raw :override #'straight--popup-raw)
|
||||
|
||||
;; HACK Replace GUI popup prompts (which hang indefinitely in tty Emacs) with
|
||||
;; simple prompts.
|
||||
(defadvice! doom-cli--straight-fallback-to-y-or-n-prompt-a (fn &optional prompt noprompt?)
|
||||
:around #'straight-are-you-sure
|
||||
(or noprompt?
|
||||
(if noninteractive
|
||||
(y-or-n-p (format! "%s" (or prompt "")))
|
||||
(funcall fn prompt))))
|
||||
|
||||
(defun doom-cli--straight-recommended-option-p (prompt option)
|
||||
(cl-loop for (prompt-re . opt-re) in doom-cli--straight-auto-options
|
||||
if (string-match-p prompt-re prompt)
|
||||
return (string-match-p opt-re option)))
|
||||
|
||||
(defadvice! doom-cli--straight-fallback-to-tty-prompt-a (fn prompt actions)
|
||||
"Modifies straight to prompt on the terminal when in noninteractive sessions."
|
||||
:around #'straight--popup-raw
|
||||
(if (bound-and-true-p async-in-child-emacs)
|
||||
(error "Straight prompt: %s" prompt)
|
||||
(let ((doom-cli--straight-auto-options doom-cli--straight-auto-options))
|
||||
;; We can't intercept C-g, so no point displaying any options for this key
|
||||
;; when C-c is the proper way to abort batch Emacs.
|
||||
(delq! "C-g" actions 'assoc)
|
||||
;; HACK These are associated with opening dired or magit, which isn't
|
||||
;; possible in tty Emacs, so...
|
||||
(delq! "e" actions 'assoc)
|
||||
(delq! "g" actions 'assoc)
|
||||
(if (doom-cli-context-suppress-prompts-p doom-cli--context)
|
||||
(cl-loop for (_key desc func) in actions
|
||||
when desc
|
||||
when (doom-cli--straight-recommended-option-p prompt desc t)
|
||||
return (funcall func))
|
||||
(print! (start "%s") (red prompt))
|
||||
(print-group!
|
||||
(terpri)
|
||||
(let (recommended options)
|
||||
(print-group!
|
||||
(print! " 1) Abort")
|
||||
(cl-loop for (_key desc func) in actions
|
||||
when desc
|
||||
do (push func options)
|
||||
and do
|
||||
(print! "%2s) %s" (1+ (length options))
|
||||
(if (doom-cli--straight-recommended-option-p prompt desc)
|
||||
(progn
|
||||
(setq doom-cli--straight-auto-options nil
|
||||
recommended (length options))
|
||||
(green (concat desc " (Choose this if unsure)")))
|
||||
desc))))
|
||||
(terpri)
|
||||
(let* ((options
|
||||
(cons (lambda ()
|
||||
(let ((doom-output-indent 0))
|
||||
(terpri)
|
||||
(print! (warn "Aborted")))
|
||||
(doom-cli--exit 1))
|
||||
(nreverse options)))
|
||||
(prompt
|
||||
(format! "How to proceed? (%s%s) "
|
||||
(mapconcat #'number-to-string
|
||||
(number-sequence 1 (length options))
|
||||
", ")
|
||||
(if (not recommended) ""
|
||||
(format "; don't know? Pick %d" (1+ recommended)))))
|
||||
answer fn)
|
||||
(while (null (nth (setq answer (1- (read-number prompt))) options))
|
||||
(print! (warn "%s is not a valid answer, try again.") answer))
|
||||
(funcall (nth answer options)))))))))
|
||||
|
||||
(setq straight-arrow " > ")
|
||||
(defadvice! doom-cli--straight-respect-print-indent-a (string &rest objects)
|
||||
"Same as `message' (which see for STRING and OBJECTS) normally.
|
||||
However, in batch mode, print to stdout instead of stderr."
|
||||
:override #'straight--output
|
||||
(let ((msg (apply #'format string objects)))
|
||||
(save-match-data
|
||||
(when (string-match (format "^%s\\(.+\\)$" (regexp-quote straight-arrow)) msg)
|
||||
(setq msg (match-string 1 msg))))
|
||||
(and (string-match-p "^\\(Cloning\\|\\(Reb\\|B\\)uilding\\) " msg)
|
||||
(not (string-suffix-p "...done" msg))
|
||||
(doom-print (concat "> " msg)))))
|
||||
|
||||
(defadvice! doom-cli--straight-ignore-gitconfig-a (fn &rest args)
|
||||
"Prevent user and system git configuration from interfering with git calls."
|
||||
:around #'straight--process-call
|
||||
(letenv! (("GIT_CONFIG" nil)
|
||||
("GIT_CONFIG_NOSYSTEM" "1")
|
||||
("GIT_CONFIG_GLOBAL" (or (getenv "DOOMGITCONFIG")
|
||||
"/dev/null")))
|
||||
(apply fn args)))
|
||||
|
||||
(provide 'doom-cli-packages)
|
||||
;;; packages.el ends here
|
||||
103
lisp/cli/run.el
Normal file
103
lisp/cli/run.el
Normal file
|
|
@ -0,0 +1,103 @@
|
|||
;;; lisp/cli/run.el --- launching Emacs in a sandbox -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
;; None yet!
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! run
|
||||
(;; TODO Implement sandbox functionality post-3.0
|
||||
;; (daemon? ("--daemon"))
|
||||
;; (window-type ("--gui" "--tty"))
|
||||
;; (version ("--with-emacs" version))
|
||||
;; (doomversion ("--with-doom" version))
|
||||
;; (profile ("--profile" name))
|
||||
(repl? ("--repl") "Launch an elisp REPL")
|
||||
;; &multiple
|
||||
;; (calls ("-f" "--funcall" fn))
|
||||
;; (loads ("-l" "--load" file))
|
||||
;; (evals ( "--eval" form))
|
||||
&context context
|
||||
&input input
|
||||
&rest args)
|
||||
"Launch Doom Emacs or an Emacs sandbox
|
||||
|
||||
Opens from bin/doom's parent directory.
|
||||
|
||||
Keep in mind there is some overhead opening Doom this way. For the best
|
||||
performance, it is best to run Doom out of ~/.config/emacs or ~/.emacs.d."
|
||||
:benchmark nil
|
||||
;; TODO Implement sandbox functionality post-3.0
|
||||
;; (when version
|
||||
;; (unless (executable-find "nix-shell")
|
||||
;; (user-error "--emacs option is not supported without nix"))
|
||||
;; ...)
|
||||
(if repl?
|
||||
(if input
|
||||
;; Evaluate piped-in text directly, if given.
|
||||
(eval (read input) t)
|
||||
(doom-run-repl context))
|
||||
;; TODO Does this work on Windows?
|
||||
(let* ((tempdir (doom-path (temporary-file-directory) "doom.run"))
|
||||
(tempemacsdir (doom-path tempdir ".emacs.d")))
|
||||
(delete-directory tempdir t)
|
||||
(make-directory tempemacsdir t)
|
||||
(with-temp-file (doom-path tempemacsdir "early-init.el")
|
||||
(prin1 `(progn
|
||||
(setenv "HOME" ,(getenv "HOME"))
|
||||
(setq user-emacs-directory ,doom-emacs-dir)
|
||||
(load-file ,(doom-path doom-emacs-dir "early-init.el")))
|
||||
(current-buffer)))
|
||||
(exit! (format "HOME=%S %s %s"
|
||||
tempdir
|
||||
invocation-name
|
||||
(combine-and-quote-strings args))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(defun doom-run-repl (context)
|
||||
"Launch a rudimentary Elisp REPL."
|
||||
;; I wrote this for fun; not with any serious intention of adding a
|
||||
;; fully-fledged REPL to the Doom CLI. Still, I occasionally need to check
|
||||
;; something, and once this has nix integration and can sandbox Emacs versions
|
||||
;; separately, it may be useful for quick tests and demos.
|
||||
(let (form)
|
||||
(while (setq form (read-from-minibuffer "(elisp) $ "))
|
||||
(when (member form '(":quit" ":q"))
|
||||
(print! "\nGoodbye!")
|
||||
(exit! 0))
|
||||
(let (debug-on-error)
|
||||
(condition-case e
|
||||
(print! "%S" (eval (read form) t))
|
||||
(error
|
||||
(let* ((n 0)
|
||||
(frame (backtrace-frame n))
|
||||
(frame-list nil)
|
||||
(in-program-stack t))
|
||||
(while frame
|
||||
(when in-program-stack
|
||||
(push (cdr frame) frame-list))
|
||||
;; (when (eq (elt frame 1) 'doom-run-repl)
|
||||
;; (setq in-program-stack t))
|
||||
(when (eq (elt frame 1) 'doom-run-repl)
|
||||
(setq in-program-stack nil))
|
||||
(setq n (1+ n)
|
||||
frame (backtrace-frame n)))
|
||||
(let* ((depth doom-cli-backtrace-depth)
|
||||
(print-escape-newlines t))
|
||||
(print! (error "There was an unexpected error"))
|
||||
(print-group!
|
||||
(print! "%s %s" (bold "Message:") (error-message-string e))
|
||||
(print! "%s %S" (bold "Details:") (cdr e))))))))
|
||||
(terpri))))
|
||||
|
||||
(provide 'doom-cli-run)
|
||||
;;; run.el ends here
|
||||
84
lisp/cli/sync.el
Normal file
84
lisp/cli/sync.el
Normal file
|
|
@ -0,0 +1,84 @@
|
|||
;;; lisp/cli/sync.el --- synchronize config command -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
(load! "packages")
|
||||
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
(defvar doom-after-sync-hook ()
|
||||
"Hooks run after 'doom sync' synchronizes the user's config with Doom.")
|
||||
|
||||
(defvar doom-before-sync-hook ()
|
||||
"Hooks run before 'doom sync' synchronizes the user's config with Doom.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defalias! (:before (sync s)) (:before build))
|
||||
|
||||
(defcli! ((sync s))
|
||||
((noenvvar? ("-e") "Don't regenerate the envvar file")
|
||||
(noelc? ("-c") "Don't recompile config")
|
||||
(update? ("-u") "Update installed packages after syncing")
|
||||
(purge? ("-p") "Purge orphaned package repos & regraft them")
|
||||
(jobs ("-j" "--jobs" num) "How many CPUs to use for native compilation"))
|
||||
"Synchronize your config with Doom Emacs.
|
||||
|
||||
This is the equivalent of running autoremove, install, autoloads, then
|
||||
recompile. Run this whenever you:
|
||||
|
||||
1. Modify your `doom!' block,
|
||||
2. Add or remove `package!' blocks to your config,
|
||||
3. Add or remove autoloaded functions in module autoloaded files.
|
||||
4. Update Doom outside of Doom (e.g. with git)
|
||||
|
||||
It will ensure that unneeded packages are removed, all needed packages are
|
||||
installed, autoloads files are up-to-date and no byte-compiled files have gone
|
||||
stale.
|
||||
|
||||
OPTIONS:
|
||||
-j, --jobs
|
||||
Defaults to the maximum number of threads (or 1, if your CPU's threadcount
|
||||
can't be determined)."
|
||||
:benchmark t
|
||||
(run-hooks 'doom-before-sync-hook)
|
||||
(add-hook 'kill-emacs-hook #'doom-sync--abort-warning-h)
|
||||
(when jobs
|
||||
(setq native-comp-async-jobs-number (truncate jobs)))
|
||||
(print! (start "Synchronizing %S profile..." )
|
||||
(if doom-profile
|
||||
(car (split-string doom-profile "@"))
|
||||
"default"))
|
||||
(unwind-protect
|
||||
(print-group!
|
||||
(when (and (not noenvvar?)
|
||||
(file-exists-p doom-env-file))
|
||||
(call! '(env)))
|
||||
(doom-packages-install)
|
||||
(doom-packages-build)
|
||||
(when update?
|
||||
(doom-packages-update))
|
||||
(doom-packages-purge purge? 'builds-p purge? purge? purge?)
|
||||
(run-hooks 'doom-after-sync-hook)
|
||||
(when (doom-autoloads-reload)
|
||||
(print! (item "Restart Emacs or use 'M-x doom/reload' for changes to take effect")))
|
||||
t)
|
||||
(remove-hook 'kill-emacs-hook #'doom-sync--abort-warning-h)))
|
||||
|
||||
;; DEPRECATED Remove when v3.0 is released
|
||||
(defobsolete! ((refresh re)) (sync) "v3.0.0")
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(defun doom-sync--abort-warning-h ()
|
||||
(print! (warn "Script was abruptly aborted, leaving Doom in an incomplete state!"))
|
||||
(print! (item "Run 'doom sync' to repair it.")))
|
||||
|
||||
(provide 'doom-cli-sync)
|
||||
;;; sync.el ends here
|
||||
48
lisp/cli/test.el
Normal file
48
lisp/cli/test.el
Normal file
|
|
@ -0,0 +1,48 @@
|
|||
;;; lisp/cli/test.el -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; The heart of Doom's test DSL and framework. Powered by either ERT or
|
||||
;; Buttercup, this extends testing frameworks to allow for isolated execution
|
||||
;; contexts on several levels, a more sophisticated CLI for tests, and
|
||||
;; integration with Doom's profiles system so testing environments can be
|
||||
;; generated on-the-fly.
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
;; TODO Implement me
|
||||
(defvar doom-test-backend 'ert
|
||||
"One of `ert' or `buttercup'.")
|
||||
|
||||
;; TODO Implement me
|
||||
(defvar doom-test-isolation-level nil
|
||||
"Determines the testing strategy for tests.
|
||||
|
||||
Should be one of:
|
||||
|
||||
nil -- Run all tests in the same session.
|
||||
file -- Run each test file in isolated sessions.
|
||||
group -- Run each group of tests in isolated sessions.
|
||||
t -- Run each individual test in isolated sessions (very slow).")
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
;; FIXME Will be fixed in v3.1
|
||||
(defstub! test
|
||||
((backend ("--ert" "--buttercup"))
|
||||
(jobs ("-j" "--jobs" int))
|
||||
&rest targets)
|
||||
"Run Doom unit tests.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
;; Nothing here yet
|
||||
|
||||
(provide 'doom-cli-test)
|
||||
;;; test.el ends here
|
||||
168
lisp/cli/upgrade.el
Normal file
168
lisp/cli/upgrade.el
Normal file
|
|
@ -0,0 +1,168 @@
|
|||
;;; lisp/cli/upgrade.el -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
(load! "packages")
|
||||
(load! "compile")
|
||||
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
(defvar doom-upgrade-url "https://github.com/doomemacs/doomemacs"
|
||||
"The git repo url for Doom Emacs.")
|
||||
|
||||
(defvar doom-upgrade-remote "_upgrade"
|
||||
"The name to use as our staging remote.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! ((upgrade up))
|
||||
((packages? ("-p" "--packages") "Only upgrade packages, not Doom")
|
||||
(jobs ("-j" "--jobs" num) "How many CPUs to use for native compilation")
|
||||
&context context)
|
||||
"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
|
||||
doom clean
|
||||
doom sync -u"
|
||||
(let* ((force? (doom-cli-context-suppress-prompts-p context))
|
||||
(sync-cmd (append '("sync" "-u") (if jobs `("-j" ,num)))))
|
||||
(cond
|
||||
(packages?
|
||||
(call! sync-cmd)
|
||||
(print! (success "Finished upgrading Doom Emacs")))
|
||||
|
||||
((doom-cli-upgrade force? force?)
|
||||
;; Reload Doom's CLI & libraries, in case there were any upstream changes.
|
||||
;; Major changes will still break, however
|
||||
(print! (item "Reloading Doom Emacs"))
|
||||
(exit! "doom" "upgrade" "-p"
|
||||
(if force? "--force")
|
||||
(if jobs (format "--jobs=%d" jobs))))
|
||||
|
||||
((print! "Doom is up-to-date!")
|
||||
(call! sync-cmd)))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(defun doom-cli-upgrade (&optional auto-accept-p force-p)
|
||||
"Upgrade Doom to the latest version non-destructively."
|
||||
(let ((default-directory doom-emacs-dir)
|
||||
process-file-side-effects)
|
||||
(print! (start "Preparing to upgrade Doom Emacs and its packages..."))
|
||||
|
||||
(let* (;; git name-rev may return BRANCH~X for detached HEADs and fully
|
||||
;; qualified refs in some other cases, so an effort to strip out all
|
||||
;; but the branch name is necessary. git symbolic-ref (or
|
||||
;; `vc-git--symbolic-ref') won't work; it can't deal with submodules.
|
||||
(branch (replace-regexp-in-string
|
||||
"^\\(?:[^/]+/[^/]+/\\)?\\(.+\\)\\(?:~[0-9]+\\)?$" "\\1"
|
||||
(cdr (doom-call-process "git" "name-rev" "--name-only" "HEAD"))))
|
||||
(target-remote (format "%s_%s" doom-upgrade-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-upgrade--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."
|
||||
(abbreviate-file-name doom-emacs-dir))
|
||||
"Either stash/undo your changes or run 'doom upgrade -f' to discard local changes."
|
||||
(string-join dirty "\n"))
|
||||
(print! (item "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-upgrade-remote)
|
||||
(unwind-protect
|
||||
(let (result)
|
||||
(or (zerop (car (doom-call-process "git" "remote" "add" doom-upgrade-remote doom-upgrade-url)))
|
||||
(error "Failed to add %s to remotes" doom-upgrade-remote))
|
||||
(or (zerop (car (setq result (doom-call-process "git" "fetch" "--force" "--tags" doom-upgrade-remote (format "%s:%s" branch target-remote)))))
|
||||
(error "Failed to fetch from upstream"))
|
||||
|
||||
(let ((this-rev (cdr (doom-call-process "git" "rev-parse" "HEAD")))
|
||||
(new-rev (cdr (doom-call-process "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!"))
|
||||
nil)
|
||||
|
||||
((print! (item "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))))
|
||||
(let ((diff-url
|
||||
(format "%s/compare/%s...%s"
|
||||
doom-upgrade-url
|
||||
this-rev
|
||||
new-rev)))
|
||||
(print! "Link to diff: %s" diff-url)
|
||||
(when (and (not auto-accept-p)
|
||||
(y-or-n-p "View the comparison diff in your browser?"))
|
||||
(print! (item "Opened github in your browser."))
|
||||
(browse-url diff-url)))
|
||||
|
||||
(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-compile-clean)
|
||||
(let ((straight-recipe (doom-upgrade--get-straight-recipe)))
|
||||
(or (and (zerop (car (doom-call-process "git" "reset" "--hard" target-remote)))
|
||||
(equal (cdr (doom-call-process "git" "rev-parse" "HEAD")) new-rev))
|
||||
(error "Failed to check out %s" (substring new-rev 0 10)))
|
||||
;; HACK It's messy to use straight to upgrade straight, due
|
||||
;; to the potential for backwards incompatibility, so we
|
||||
;; staticly check if Doom's `package!' declaration for
|
||||
;; straight has changed. If it has, delete straight so
|
||||
;; 'doom upgrade's second stage will install the new
|
||||
;; version for us.
|
||||
;;
|
||||
;; Clumsy, but a better solution is in the works.
|
||||
(unless (equal straight-recipe (doom-upgrade--get-straight-recipe))
|
||||
(print! (item "Preparing straight for an update"))
|
||||
(delete-directory (doom-path straight-base-dir "straight/repos/straight.el")
|
||||
'recursive)))
|
||||
(print! (item "%s") (cdr result))
|
||||
t))))))
|
||||
(ignore-errors
|
||||
(doom-call-process "git" "branch" "-D" target-remote)
|
||||
(doom-call-process "git" "remote" "remove" doom-upgrade-remote))))))
|
||||
|
||||
(defun doom-upgrade--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-upgrade--get-straight-recipe ()
|
||||
(with-temp-buffer
|
||||
(insert-file-contents (doom-path doom-core-dir "packages.el"))
|
||||
(when (re-search-forward "(package! straight" nil t)
|
||||
(goto-char (match-beginning 0))
|
||||
(let ((sexp (sexp-at-point)))
|
||||
(plist-put sexp :recipe
|
||||
(eval (plist-get sexp :recipe)
|
||||
t))))))
|
||||
|
||||
;;; upgrade.el ends here
|
||||
Loading…
Add table
Add a link
Reference in a new issue