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
|
||||
1816
lisp/doom-cli-lib.el
Normal file
1816
lisp/doom-cli-lib.el
Normal file
File diff suppressed because it is too large
Load diff
150
lisp/doom-cli.el
Normal file
150
lisp/doom-cli.el
Normal file
|
|
@ -0,0 +1,150 @@
|
|||
;;; lisp/doom-cli.el --- The heart of Doom's CLI framework -*- lexical-binding: t; no-byte-compile: t; -*-
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; The bootstrapper for Doom's CLI. This is *not* safe to load in interactive
|
||||
;; sessions as it has many side-effects. Loads `doom-cli-lib' instead for API
|
||||
;; access and syntax highlighting.
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(when (version< emacs-version "27.1")
|
||||
(message
|
||||
(concat
|
||||
"Error: detected Emacs " emacs-version ", but 27.1 or newer is required.\n\n"
|
||||
"The version of Emacs in use is located at:\n\n " (car command-line-args) "\n\n"
|
||||
"A guide for installing a newer version of Emacs can be found at:\n\n "
|
||||
(format "https://doomemacs.org/docs/getting_started.org#%s\n"
|
||||
(cond ((eq system-type 'darwin) "on-macos")
|
||||
((memq system-type '(cygwin windows-nt ms-dos)) "on-windows")
|
||||
("on-linux"))) "\n"
|
||||
"Alternatively, alter the EMACS environment variable to temporarily change what\n"
|
||||
"command this script uses to invoke Emacs. For example:\n\n"
|
||||
(let ((command (file-name-nondirectory (cadr (member "--load" command-line-args)))))
|
||||
(concat " $ EMACS=/path/to/valid/emacs " command " ...\n"
|
||||
" $ EMACS=\"/Applications/Emacs.app/Contents/MacOS/Emacs\" " command " ...\n"
|
||||
" $ EMACS=\"snap run emacs\" " command " ...\n"))
|
||||
"\nAborting..."))
|
||||
(kill-emacs 2))
|
||||
|
||||
|
||||
;;
|
||||
;;; Setup CLI session
|
||||
|
||||
;; The garbage collector isn't so important during CLI ops. A higher threshold
|
||||
;; makes it 15-30% faster, but set it too high and we risk runaway memory usage
|
||||
;; in longer sessions.
|
||||
(setq gc-cons-threshold 134217728 ; 128mb
|
||||
gc-cons-percentage 1.0)
|
||||
|
||||
;; Ensure errors are sufficiently detailed from this point on.
|
||||
(setq debug-on-error t)
|
||||
;; Be more verbose if debug mode is on.
|
||||
(when (setq init-file-debug (getenv "DEBUG"))
|
||||
(message "Debug mode enabled"))
|
||||
|
||||
;;; Initialize profile
|
||||
(let ((profile (getenv "DOOMPROFILE")))
|
||||
(when profile
|
||||
(with-temp-buffer
|
||||
(let ((coding-system-for-read 'utf-8-auto)
|
||||
(profiles-file (expand-file-name "profiles.el" user-emacs-directory)))
|
||||
(condition-case e
|
||||
(progn
|
||||
(insert-file-contents profiles-file)
|
||||
(dolist (var (or (cdr (assq (intern profile) (read (current-buffer))))
|
||||
(progn (message "No %S profile found" profile)
|
||||
(kill-emacs 3))))
|
||||
(if (eq (car var) 'env)
|
||||
(dolist (env (cdr var)) (setenv (car env) (cdr env)))
|
||||
(set (car var) (cdr var)))))
|
||||
(file-missing
|
||||
(message "No $EMACSDIR/%s file to look up %S in."
|
||||
(file-name-nondirectory profiles-file)
|
||||
profile)
|
||||
(kill-emacs 3))
|
||||
(end-of-file (signal 'end-of-file (list profiles-file)))
|
||||
(error (error "Parser error in profiles.el: %s" (error-message-string e))))))))
|
||||
|
||||
;; HACK Load `cl' and site files manually to prevent polluting logs and stdout
|
||||
;; with deprecation and/or file load messages.
|
||||
(let ((inhibit-message (not init-file-debug)))
|
||||
(require 'cl)
|
||||
(unless site-run-file
|
||||
(let ((site-run-file "site-start")
|
||||
(tail load-path)
|
||||
(lispdir (expand-file-name "../lisp" data-directory))
|
||||
dir)
|
||||
(while tail
|
||||
(setq dir (car tail))
|
||||
(let ((default-directory dir))
|
||||
(load (expand-file-name "subdirs.el") t inhibit-message t))
|
||||
(unless (string-prefix-p lispdir dir)
|
||||
(let ((default-directory dir))
|
||||
(load (expand-file-name "leim-list.el") t inhibit-message t)))
|
||||
(setq tail (cdr tail)))
|
||||
(load site-run-file t inhibit-message))))
|
||||
|
||||
;; Just the... bear necessities~
|
||||
(require 'doom (expand-file-name "doom" (file-name-directory load-file-name)))
|
||||
|
||||
;; Load these eagerly, since autoloads haven't been generated/loaded yet
|
||||
(load! "lib/process")
|
||||
(load! "lib/system")
|
||||
(load! "lib/plist")
|
||||
(load! "lib/files")
|
||||
(load! "lib/debug")
|
||||
(load! "lib/print")
|
||||
;; (load! "lib/autoloads")
|
||||
|
||||
;; Ensure straight and core packages are ready to go for CLI commands.
|
||||
(require 'doom-modules)
|
||||
(require 'doom-packages)
|
||||
|
||||
;; Our DSL, API, and everything nice.
|
||||
(require 'doom-cli-lib)
|
||||
|
||||
;; Don't generate superfluous files when writing temp buffers.
|
||||
(setq make-backup-files nil)
|
||||
;; Stop user configuration from interfering with package management.
|
||||
(setq enable-dir-local-variables nil)
|
||||
;; Reduce ambiguity, embrace specificity, enjoy predictability.
|
||||
(setq-default case-fold-search nil)
|
||||
;; Don't clog the user's trash with anything we clean up during this session.
|
||||
(setq delete-by-moving-to-trash nil)
|
||||
|
||||
|
||||
;;
|
||||
;;; Bootstrap
|
||||
|
||||
;; Use our own home-grown debugger so we can capture backtraces, make them more
|
||||
;; presentable, and write them to a file. Cleaner backtraces are better UX than
|
||||
;; the giant wall of text the default debugger throws up.
|
||||
(setq debugger #'doom-cli-debugger)
|
||||
|
||||
;; Create all our core directories to quell file errors.
|
||||
(mapc (doom-rpartial #'make-directory 'parents)
|
||||
(list doom-local-dir
|
||||
doom-etc-dir
|
||||
doom-cache-dir))
|
||||
|
||||
;; Load standard :help and :version handlers.
|
||||
(load! "cli/help")
|
||||
|
||||
;; When __DOOMDUMP is set, doomscripts trigger this special handler.
|
||||
(defcli! (:root :dump)
|
||||
((pretty? ("--pretty") "Pretty print output")
|
||||
&context context
|
||||
&args commands)
|
||||
"Dump metadata to stdout for other commands to read."
|
||||
(let* ((prefix (doom-cli-context-prefix context))
|
||||
(command (cons prefix commands)))
|
||||
(funcall (if pretty? #'pp #'prin1)
|
||||
(cond ((equal commands '("-")) (hash-table-values doom-cli--table))
|
||||
(commands (doom-cli-find command))
|
||||
((doom-cli-find (list prefix)))))
|
||||
(terpri)
|
||||
;; Kill manually so we don't save output to logs.
|
||||
(let (kill-emacs) (kill-emacs 0))))
|
||||
|
||||
(provide 'doom-cli)
|
||||
;;; doom-cli.el ends here
|
||||
724
lisp/doom-editor.el
Normal file
724
lisp/doom-editor.el
Normal file
|
|
@ -0,0 +1,724 @@
|
|||
;;; doom-editor.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defvar doom-detect-indentation-excluded-modes
|
||||
'(fundamental-mode pascal-mode so-long-mode)
|
||||
"A list of major modes in which indentation should be automatically
|
||||
detected.")
|
||||
|
||||
(defvar-local doom-inhibit-indent-detection nil
|
||||
"A buffer-local flag that indicates whether `dtrt-indent' should try to detect
|
||||
indentation settings or not. This should be set by editorconfig if it
|
||||
successfully sets indent_style/indent_size.")
|
||||
|
||||
(defvar doom-inhibit-large-file-detection nil
|
||||
"If non-nil, inhibit large/long file detection when opening files.")
|
||||
|
||||
(defvar doom-large-file-p nil)
|
||||
(put 'doom-large-file-p 'permanent-local t)
|
||||
|
||||
(defvar doom-large-file-size-alist '(("." . 1.0))
|
||||
"An alist mapping regexps (like `auto-mode-alist') to filesize thresholds.
|
||||
|
||||
If a file is opened and discovered to be larger than the threshold, Doom
|
||||
performs emergency optimizations to prevent Emacs from hanging, crashing or
|
||||
becoming unusably slow.
|
||||
|
||||
These thresholds are in MB, and is used by `doom--optimize-for-large-files-a'.")
|
||||
|
||||
(defvar doom-large-file-excluded-modes
|
||||
'(so-long-mode special-mode archive-mode tar-mode jka-compr
|
||||
git-commit-mode image-mode doc-view-mode doc-view-mode-maybe
|
||||
ebrowse-tree-mode pdf-view-mode tags-table-mode)
|
||||
"Major modes that `doom-check-large-file-h' will ignore.")
|
||||
|
||||
|
||||
;;
|
||||
;;; File handling
|
||||
|
||||
(defadvice! doom--prepare-for-large-files-a (size _ filename &rest _)
|
||||
"Sets `doom-large-file-p' if the file is considered large.
|
||||
|
||||
Uses `doom-large-file-size-alist' to determine when a file is too large. When
|
||||
`doom-large-file-p' is set, other plugins can detect this and reduce their
|
||||
runtime costs (or disable themselves) to ensure the buffer is as fast as
|
||||
possible."
|
||||
:before #'abort-if-file-too-large
|
||||
(and (numberp size)
|
||||
(null doom-inhibit-large-file-detection)
|
||||
(ignore-errors
|
||||
(> size
|
||||
(* 1024 1024
|
||||
(assoc-default filename doom-large-file-size-alist
|
||||
#'string-match-p))))
|
||||
(setq-local doom-large-file-p size)))
|
||||
|
||||
(add-hook! 'find-file-hook
|
||||
(defun doom-optimize-for-large-files-h ()
|
||||
"Trigger `so-long-minor-mode' if the file is large."
|
||||
(when (and doom-large-file-p buffer-file-name)
|
||||
(if (or doom-inhibit-large-file-detection
|
||||
(memq major-mode doom-large-file-excluded-modes))
|
||||
(kill-local-variable 'doom-large-file-p)
|
||||
(when (fboundp 'so-long-minor-mode) ; in case the user disabled it
|
||||
(so-long-minor-mode +1))
|
||||
(message "Large file detected! Cutting a few corners to improve performance...")))))
|
||||
|
||||
|
||||
;; Resolve symlinks when opening files, so that any operations are conducted
|
||||
;; from the file's true directory (like `find-file').
|
||||
(setq find-file-visit-truename t
|
||||
vc-follow-symlinks t)
|
||||
|
||||
;; Disable the warning "X and Y are the same file". It's fine to ignore this
|
||||
;; warning as it will redirect you to the existing buffer anyway.
|
||||
(setq find-file-suppress-same-file-warnings t)
|
||||
|
||||
;; Create missing directories when we open a file that doesn't exist under a
|
||||
;; directory tree that may not exist.
|
||||
(add-hook! 'find-file-not-found-functions
|
||||
(defun doom-create-missing-directories-h ()
|
||||
"Automatically create missing directories when creating new files."
|
||||
(unless (file-remote-p buffer-file-name)
|
||||
(let ((parent-directory (file-name-directory buffer-file-name)))
|
||||
(and (not (file-directory-p parent-directory))
|
||||
(y-or-n-p (format "Directory `%s' does not exist! Create it?"
|
||||
parent-directory))
|
||||
(progn (make-directory parent-directory 'parents)
|
||||
t))))))
|
||||
|
||||
;; Don't generate backups or lockfiles. While auto-save maintains a copy so long
|
||||
;; as a buffer is unsaved, backups create copies once, when the file is first
|
||||
;; written, and never again until it is killed and reopened. This is better
|
||||
;; suited to version control, and I don't want world-readable copies of
|
||||
;; potentially sensitive material floating around our filesystem.
|
||||
(setq create-lockfiles nil
|
||||
make-backup-files nil
|
||||
;; But in case the user does enable it, some sensible defaults:
|
||||
version-control t ; number each backup file
|
||||
backup-by-copying t ; instead of renaming current file (clobbers links)
|
||||
delete-old-versions t ; clean up after itself
|
||||
kept-old-versions 5
|
||||
kept-new-versions 5
|
||||
backup-directory-alist (list (cons "." (concat doom-cache-dir "backup/")))
|
||||
tramp-backup-directory-alist backup-directory-alist)
|
||||
|
||||
;; But turn on auto-save, so we have a fallback in case of crashes or lost data.
|
||||
;; Use `recover-file' or `recover-session' to recover them.
|
||||
(setq auto-save-default t
|
||||
;; Don't auto-disable auto-save after deleting big chunks. This defeats
|
||||
;; the purpose of a failsafe. This adds the risk of losing the data we
|
||||
;; just deleted, but I believe that's VCS's jurisdiction, not ours.
|
||||
auto-save-include-big-deletions t
|
||||
;; Keep it out of `doom-emacs-dir' or the local directory.
|
||||
auto-save-list-file-prefix (concat doom-cache-dir "autosave/")
|
||||
tramp-auto-save-directory (concat doom-cache-dir "tramp-autosave/")
|
||||
auto-save-file-name-transforms
|
||||
(list (list "\\`/[^/]*:\\([^/]*/\\)*\\([^/]*\\)\\'"
|
||||
;; Prefix tramp autosaves to prevent conflicts with local ones
|
||||
(concat auto-save-list-file-prefix "tramp-\\2") t)
|
||||
(list ".*" auto-save-list-file-prefix t)))
|
||||
|
||||
(add-hook! 'after-save-hook
|
||||
(defun doom-guess-mode-h ()
|
||||
"Guess major mode when saving a file in `fundamental-mode'.
|
||||
|
||||
Likely, something has changed since the buffer was opened. e.g. A shebang line
|
||||
or file path may exist now."
|
||||
(when (eq major-mode 'fundamental-mode)
|
||||
(let ((buffer (or (buffer-base-buffer) (current-buffer))))
|
||||
(and (buffer-file-name buffer)
|
||||
(eq buffer (window-buffer (selected-window))) ; only visible buffers
|
||||
(set-auto-mode))))))
|
||||
|
||||
(defadvice! doom--shut-up-autosave-a (fn &rest args)
|
||||
"If a file has autosaved data, `after-find-file' will pause for 1 second to
|
||||
tell you about it. Very annoying. This prevents that."
|
||||
:around #'after-find-file
|
||||
(letf! ((#'sit-for #'ignore))
|
||||
(apply fn args)))
|
||||
|
||||
;; HACK Emacs generates long file paths for its auto-save files; long =
|
||||
;; `auto-save-list-file-prefix' + `buffer-file-name'. If too long, the
|
||||
;; filesystem will murder your family. To appease it, I compress
|
||||
;; `buffer-file-name' to a stable 40 characters.
|
||||
;; TODO PR this upstream; should be a universal issue!
|
||||
(defadvice! doom-make-hashed-auto-save-file-name-a (fn)
|
||||
"Compress the auto-save file name so paths don't get too long."
|
||||
:around #'make-auto-save-file-name
|
||||
(let ((buffer-file-name
|
||||
(if (or
|
||||
;; Don't do anything for non-file-visiting buffers. Names
|
||||
;; generated for those are short enough already.
|
||||
(null buffer-file-name)
|
||||
;; If an alternate handler exists for this path, bow out. Most of
|
||||
;; them end up calling `make-auto-save-file-name' again anyway, so
|
||||
;; we still achieve this advice's ultimate goal.
|
||||
(find-file-name-handler buffer-file-name
|
||||
'make-auto-save-file-name))
|
||||
buffer-file-name
|
||||
(sha1 buffer-file-name))))
|
||||
(funcall fn)))
|
||||
|
||||
;; HACK ...does the same for Emacs backup files, but also packages that use
|
||||
;; `make-backup-file-name-1' directly (like undo-tree).
|
||||
(defadvice! doom-make-hashed-backup-file-name-a (fn file)
|
||||
"A few places use the backup file name so paths don't get too long."
|
||||
:around #'make-backup-file-name-1
|
||||
(let ((alist backup-directory-alist)
|
||||
backup-directory)
|
||||
(while alist
|
||||
(let ((elt (car alist)))
|
||||
(if (string-match (car elt) file)
|
||||
(setq backup-directory (cdr elt)
|
||||
alist nil)
|
||||
(setq alist (cdr alist)))))
|
||||
(let ((file (funcall fn file)))
|
||||
(if (or (null backup-directory)
|
||||
(not (file-name-absolute-p backup-directory)))
|
||||
file
|
||||
(expand-file-name (sha1 (file-name-nondirectory file))
|
||||
(file-name-directory file))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Formatting
|
||||
|
||||
;; Favor spaces over tabs. Pls dun h8, but I think spaces (and 4 of them) is a
|
||||
;; more consistent default than 8-space tabs. It can be changed on a per-mode
|
||||
;; basis anyway (and is, where tabs are the canonical style, like go-mode).
|
||||
(setq-default indent-tabs-mode nil
|
||||
tab-width 4)
|
||||
|
||||
;; Only indent the line when at BOL or in a line's indentation. Anywhere else,
|
||||
;; insert literal indentation.
|
||||
(setq-default tab-always-indent nil)
|
||||
|
||||
;; Make `tabify' and `untabify' only affect indentation. Not tabs/spaces in the
|
||||
;; middle of a line.
|
||||
(setq tabify-regexp "^\t* [ \t]+")
|
||||
|
||||
;; An archaic default in the age of widescreen 4k displays? I disagree. We still
|
||||
;; frequently split our terminals and editor frames, or have them side-by-side,
|
||||
;; using up more of that newly available horizontal real-estate.
|
||||
(setq-default fill-column 80)
|
||||
|
||||
;; Continue wrapped words at whitespace, rather than in the middle of a word.
|
||||
(setq-default word-wrap t)
|
||||
;; ...but don't do any wrapping by default. It's expensive. Enable
|
||||
;; `visual-line-mode' if you want soft line-wrapping. `auto-fill-mode' for hard
|
||||
;; line-wrapping.
|
||||
(setq-default truncate-lines t)
|
||||
;; If enabled (and `truncate-lines' was disabled), soft wrapping no longer
|
||||
;; occurs when that window is less than `truncate-partial-width-windows'
|
||||
;; characters wide. We don't need this, and it's extra work for Emacs otherwise,
|
||||
;; so off it goes.
|
||||
(setq truncate-partial-width-windows nil)
|
||||
|
||||
;; This was a widespread practice in the days of typewriters. I actually prefer
|
||||
;; it when writing prose with monospace fonts, but it is obsolete otherwise.
|
||||
(setq sentence-end-double-space nil)
|
||||
|
||||
;; The POSIX standard defines a line is "a sequence of zero or more non-newline
|
||||
;; characters followed by a terminating newline", so files should end in a
|
||||
;; newline. Windows doesn't respect this (because it's Windows), but we should,
|
||||
;; since programmers' tools tend to be POSIX compliant (and no big deal if not).
|
||||
(setq require-final-newline t)
|
||||
|
||||
;; Default to soft line-wrapping in text modes. It is more sensibile for text
|
||||
;; modes, even if hard wrapping is more performant.
|
||||
(add-hook 'text-mode-hook #'visual-line-mode)
|
||||
|
||||
|
||||
;;
|
||||
;;; Clipboard / kill-ring
|
||||
|
||||
;; Cull duplicates in the kill ring to reduce bloat and make the kill ring
|
||||
;; easier to peruse (with `counsel-yank-pop' or `helm-show-kill-ring'.
|
||||
(setq kill-do-not-save-duplicates t)
|
||||
|
||||
|
||||
;;
|
||||
;;; Extra file extensions to support
|
||||
|
||||
(nconc
|
||||
auto-mode-alist
|
||||
'(("/LICENSE\\'" . text-mode)
|
||||
("\\.log\\'" . text-mode)
|
||||
("rc\\'" . conf-mode)
|
||||
("\\.\\(?:hex\\|nes\\)\\'" . hexl-mode)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Built-in plugins
|
||||
|
||||
(use-package! autorevert
|
||||
;; revert buffers when their files/state have changed
|
||||
:hook (focus-in . doom-auto-revert-buffers-h)
|
||||
:hook (after-save . doom-auto-revert-buffers-h)
|
||||
:hook (doom-switch-buffer . doom-auto-revert-buffer-h)
|
||||
:hook (doom-switch-window . doom-auto-revert-buffer-h)
|
||||
:config
|
||||
(setq auto-revert-verbose t ; let us know when it happens
|
||||
auto-revert-use-notify nil
|
||||
auto-revert-stop-on-user-input nil
|
||||
;; Only prompts for confirmation when buffer is unsaved.
|
||||
revert-without-query (list "."))
|
||||
|
||||
;; `auto-revert-mode' and `global-auto-revert-mode' would, normally, abuse the
|
||||
;; heck out of file watchers _or_ aggressively poll your buffer list every X
|
||||
;; seconds. Too many watchers can grind Emacs to a halt if you preform
|
||||
;; expensive or batch processes on files outside of Emacs (e.g. their mtime
|
||||
;; changes), and polling your buffer list is terribly inefficient as your
|
||||
;; buffer list grows into the hundreds.
|
||||
;;
|
||||
;; Doom does this lazily instead. i.e. All visible buffers are reverted
|
||||
;; immediately when a) a file is saved or b) Emacs is refocused (after using
|
||||
;; another app). Meanwhile, buried buffers are reverted only when they are
|
||||
;; switched to. This way, Emacs only ever has to operate on, at minimum, a
|
||||
;; single buffer and, at maximum, ~10 buffers (after all, when do you ever
|
||||
;; have more than 10 windows in any single frame?).
|
||||
(defun doom-auto-revert-buffer-h ()
|
||||
"Auto revert current buffer, if necessary."
|
||||
(unless (or auto-revert-mode (active-minibuffer-window))
|
||||
(let ((auto-revert-mode t))
|
||||
(auto-revert-handler))))
|
||||
|
||||
(defun doom-auto-revert-buffers-h ()
|
||||
"Auto revert stale buffers in visible windows, if necessary."
|
||||
(dolist (buf (doom-visible-buffers))
|
||||
(with-current-buffer buf
|
||||
(doom-auto-revert-buffer-h)))))
|
||||
|
||||
|
||||
(use-package! recentf
|
||||
;; Keep track of recently opened files
|
||||
:defer-incrementally easymenu tree-widget timer
|
||||
:hook (doom-first-file . recentf-mode)
|
||||
:commands recentf-open-files
|
||||
:custom (recentf-save-file (concat doom-cache-dir "recentf"))
|
||||
:config
|
||||
(setq recentf-auto-cleanup nil ; Don't. We'll auto-cleanup on shutdown
|
||||
recentf-max-saved-items 200) ; default is 20
|
||||
|
||||
(defun doom--recentf-file-truename-fn (file)
|
||||
(if (or (not (file-remote-p file))
|
||||
(equal "sudo" (file-remote-p file 'method)))
|
||||
(abbreviate-file-name (file-truename (tramp-file-name-localname tfile)))
|
||||
file))
|
||||
|
||||
;; Anything in runtime folders
|
||||
(add-to-list 'recentf-exclude
|
||||
(concat "^" (regexp-quote (or (getenv "XDG_RUNTIME_DIR")
|
||||
"/run"))))
|
||||
|
||||
;; Resolve symlinks, strip out the /sudo:X@ prefix in local tramp paths, and
|
||||
;; abbreviate $HOME -> ~ in filepaths (more portable, more readable, & saves
|
||||
;; space)
|
||||
(add-to-list 'recentf-filename-handlers #'doom--recentf-file-truename-fn)
|
||||
|
||||
;; Text properties inflate the size of recentf's files, and there is
|
||||
;; no purpose in persisting them (Must be first in the list!)
|
||||
(add-to-list 'recentf-filename-handlers #'substring-no-properties)
|
||||
|
||||
(add-hook! '(doom-switch-window-hook write-file-functions)
|
||||
(defun doom--recentf-touch-buffer-h ()
|
||||
"Bump file in recent file list when it is switched or written to."
|
||||
(when buffer-file-name
|
||||
(recentf-add-file buffer-file-name))
|
||||
;; Return nil for `write-file-functions'
|
||||
nil))
|
||||
|
||||
(add-hook! 'dired-mode-hook
|
||||
(defun doom--recentf-add-dired-directory-h ()
|
||||
"Add dired directories to recentf file list."
|
||||
(recentf-add-file default-directory)))
|
||||
|
||||
;; The most sensible time to clean up your recent files list is when you quit
|
||||
;; Emacs (unless this is a long-running daemon session).
|
||||
(setq recentf-auto-cleanup (if (daemonp) 300))
|
||||
(add-hook 'kill-emacs-hook #'recentf-cleanup)
|
||||
|
||||
;; Otherwise `load-file' calls in `recentf-load-list' pollute *Messages*
|
||||
(advice-add #'recentf-load-list :around #'doom-shut-up-a))
|
||||
|
||||
|
||||
(use-package! savehist
|
||||
;; persist variables across sessions
|
||||
:defer-incrementally custom
|
||||
:hook (doom-first-input . savehist-mode)
|
||||
:custom (savehist-file (concat doom-cache-dir "savehist"))
|
||||
:config
|
||||
(setq savehist-save-minibuffer-history t
|
||||
savehist-autosave-interval nil ; save on kill only
|
||||
savehist-additional-variables
|
||||
'(kill-ring ; persist clipboard
|
||||
register-alist ; persist macros
|
||||
mark-ring global-mark-ring ; persist marks
|
||||
search-ring regexp-search-ring)) ; persist searches
|
||||
(add-hook! 'savehist-save-hook
|
||||
(defun doom-savehist-unpropertize-variables-h ()
|
||||
"Remove text properties from `kill-ring' to reduce savehist cache size."
|
||||
(setq kill-ring
|
||||
(mapcar #'substring-no-properties
|
||||
(cl-remove-if-not #'stringp kill-ring))
|
||||
register-alist
|
||||
(cl-loop for (reg . item) in register-alist
|
||||
if (stringp item)
|
||||
collect (cons reg (substring-no-properties item))
|
||||
else collect (cons reg item))))
|
||||
(defun doom-savehist-remove-unprintable-registers-h ()
|
||||
"Remove unwriteable registers (e.g. containing window configurations).
|
||||
Otherwise, `savehist' would discard `register-alist' entirely if we don't omit
|
||||
the unwritable tidbits."
|
||||
;; Save new value in the temp buffer savehist is running
|
||||
;; `savehist-save-hook' in. We don't want to actually remove the
|
||||
;; unserializable registers in the current session!
|
||||
(setq-local register-alist
|
||||
(cl-remove-if-not #'savehist-printable register-alist)))))
|
||||
|
||||
|
||||
(use-package! saveplace
|
||||
;; persistent point location in buffers
|
||||
:hook (doom-first-file . save-place-mode)
|
||||
:custom (save-place-file (concat doom-cache-dir "saveplace"))
|
||||
:config
|
||||
(defadvice! doom--recenter-on-load-saveplace-a (&rest _)
|
||||
"Recenter on cursor when loading a saved place."
|
||||
:after-while #'save-place-find-file-hook
|
||||
(if buffer-file-name (ignore-errors (recenter))))
|
||||
|
||||
(defadvice! doom--inhibit-saveplace-in-long-files-a (fn &rest args)
|
||||
:around #'save-place-to-alist
|
||||
(unless doom-large-file-p
|
||||
(apply fn args)))
|
||||
|
||||
(defadvice! doom--dont-prettify-saveplace-cache-a (fn)
|
||||
"`save-place-alist-to-file' uses `pp' to prettify the contents of its cache.
|
||||
`pp' can be expensive for longer lists, and there's no reason to prettify cache
|
||||
files, so this replace calls to `pp' with the much faster `prin1'."
|
||||
:around #'save-place-alist-to-file
|
||||
(letf! ((#'pp #'prin1)) (funcall fn))))
|
||||
|
||||
|
||||
(use-package! server
|
||||
:when (display-graphic-p)
|
||||
:after-call doom-first-input-hook doom-first-file-hook focus-out-hook
|
||||
:custom (server-auth-dir (concat doom-emacs-dir "server/"))
|
||||
:defer 1
|
||||
:init
|
||||
(when-let (name (getenv "EMACS_SERVER_NAME"))
|
||||
(setq server-name name))
|
||||
:config
|
||||
(unless (server-running-p)
|
||||
(server-start)))
|
||||
|
||||
|
||||
(after! tramp
|
||||
(setq remote-file-name-inhibit-cache 60
|
||||
tramp-completion-reread-directory-timeout 60
|
||||
tramp-verbose 1
|
||||
vc-ignore-dir-regexp (format "%s\\|%s\\|%s"
|
||||
vc-ignore-dir-regexp
|
||||
tramp-file-name-regexp
|
||||
"[/\\\\]node_modules")))
|
||||
|
||||
|
||||
;;
|
||||
;;; Packages
|
||||
|
||||
(use-package! better-jumper
|
||||
:hook (doom-first-input . better-jumper-mode)
|
||||
:commands doom-set-jump-a doom-set-jump-maybe-a doom-set-jump-h
|
||||
:preface
|
||||
;; REVIEW Suppress byte-compiler warning spawning a *Compile-Log* buffer at
|
||||
;; startup. This can be removed once gilbertw1/better-jumper#2 is merged.
|
||||
(defvar better-jumper-local-mode nil)
|
||||
:init
|
||||
(global-set-key [remap evil-jump-forward] #'better-jumper-jump-forward)
|
||||
(global-set-key [remap evil-jump-backward] #'better-jumper-jump-backward)
|
||||
(global-set-key [remap xref-pop-marker-stack] #'better-jumper-jump-backward)
|
||||
(global-set-key [remap xref-go-back] #'better-jumper-jump-backward)
|
||||
(global-set-key [remap xref-go-forward] #'better-jumper-jump-forward)
|
||||
:config
|
||||
(defun doom-set-jump-a (fn &rest args)
|
||||
"Set a jump point and ensure fn doesn't set any new jump points."
|
||||
(better-jumper-set-jump (if (markerp (car args)) (car args)))
|
||||
(let ((evil--jumps-jumping t)
|
||||
(better-jumper--jumping t))
|
||||
(apply fn args)))
|
||||
|
||||
(defun doom-set-jump-maybe-a (fn &rest args)
|
||||
"Set a jump point if fn actually moves the point."
|
||||
(let ((origin (point-marker))
|
||||
(result
|
||||
(let* ((evil--jumps-jumping t)
|
||||
(better-jumper--jumping t))
|
||||
(apply fn args)))
|
||||
(dest (point-marker)))
|
||||
(unless (equal origin dest)
|
||||
(with-current-buffer (marker-buffer origin)
|
||||
(better-jumper-set-jump
|
||||
(if (markerp (car args))
|
||||
(car args)
|
||||
origin))))
|
||||
(set-marker origin nil)
|
||||
(set-marker dest nil)
|
||||
result))
|
||||
|
||||
(defun doom-set-jump-h ()
|
||||
"Run `better-jumper-set-jump' but return nil, for short-circuiting hooks."
|
||||
(better-jumper-set-jump)
|
||||
nil)
|
||||
|
||||
;; Creates a jump point before killing a buffer. This allows you to undo
|
||||
;; killing a buffer easily (only works with file buffers though; it's not
|
||||
;; possible to resurrect special buffers).
|
||||
;;
|
||||
;; I'm not advising `kill-buffer' because I only want this to affect
|
||||
;; interactively killed buffers.
|
||||
(advice-add #'kill-current-buffer :around #'doom-set-jump-a)
|
||||
|
||||
;; Create a jump point before jumping with imenu.
|
||||
(advice-add #'imenu :around #'doom-set-jump-a))
|
||||
|
||||
|
||||
(use-package! dtrt-indent
|
||||
;; Automatic detection of indent settings
|
||||
:unless noninteractive
|
||||
;; I'm not using `global-dtrt-indent-mode' because it has hard-coded and rigid
|
||||
;; major mode checks, so I implement it in `doom-detect-indentation-h'.
|
||||
:hook ((change-major-mode-after-body read-only-mode) . doom-detect-indentation-h)
|
||||
:config
|
||||
(defun doom-detect-indentation-h ()
|
||||
(unless (or (not after-init-time)
|
||||
doom-inhibit-indent-detection
|
||||
doom-large-file-p
|
||||
(memq major-mode doom-detect-indentation-excluded-modes)
|
||||
(member (substring (buffer-name) 0 1) '(" " "*")))
|
||||
;; Don't display messages in the echo area, but still log them
|
||||
(let ((inhibit-message (not init-file-debug)))
|
||||
(dtrt-indent-mode +1))))
|
||||
|
||||
;; Enable dtrt-indent even in smie modes so that it can update `tab-width',
|
||||
;; `standard-indent' and `evil-shift-width' there as well.
|
||||
(setq dtrt-indent-run-after-smie t)
|
||||
;; Reduced from the default of 5000 for slightly faster analysis
|
||||
(setq dtrt-indent-max-lines 2000)
|
||||
|
||||
;; always keep tab-width up-to-date
|
||||
(push '(t tab-width) dtrt-indent-hook-generic-mapping-list)
|
||||
|
||||
(defvar dtrt-indent-run-after-smie)
|
||||
(defadvice! doom--fix-broken-smie-modes-a (fn &optional arg)
|
||||
"Some smie modes throw errors when trying to guess their indentation, like
|
||||
`nim-mode'. This prevents them from leaving Emacs in a broken state."
|
||||
:around #'dtrt-indent-mode
|
||||
(let ((dtrt-indent-run-after-smie dtrt-indent-run-after-smie))
|
||||
(letf! ((defun symbol-config--guess (beg end)
|
||||
(funcall symbol-config--guess beg (min end 10000)))
|
||||
(defun smie-config-guess ()
|
||||
(condition-case e (funcall smie-config-guess)
|
||||
(error (setq dtrt-indent-run-after-smie t)
|
||||
(message "[WARNING] Indent detection: %s"
|
||||
(error-message-string e))
|
||||
(message ""))))) ; warn silently
|
||||
(funcall fn arg)))))
|
||||
|
||||
(use-package! helpful
|
||||
;; a better *help* buffer
|
||||
:commands helpful--read-symbol
|
||||
:hook (helpful-mode . visual-line-mode)
|
||||
:init
|
||||
;; Make `apropos' et co search more extensively. They're more useful this way.
|
||||
(setq apropos-do-all t)
|
||||
|
||||
(global-set-key [remap describe-function] #'helpful-callable)
|
||||
(global-set-key [remap describe-command] #'helpful-command)
|
||||
(global-set-key [remap describe-variable] #'helpful-variable)
|
||||
(global-set-key [remap describe-key] #'helpful-key)
|
||||
(global-set-key [remap describe-symbol] #'helpful-symbol)
|
||||
|
||||
(defun doom-use-helpful-a (fn &rest args)
|
||||
"Force FN to use helpful instead of the old describe-* commands."
|
||||
(letf! ((#'describe-function #'helpful-function)
|
||||
(#'describe-variable #'helpful-variable))
|
||||
(apply fn args)))
|
||||
|
||||
(after! apropos
|
||||
;; patch apropos buttons to call helpful instead of help
|
||||
(dolist (fun-bt '(apropos-function apropos-macro apropos-command))
|
||||
(button-type-put
|
||||
fun-bt 'action
|
||||
(lambda (button)
|
||||
(helpful-callable (button-get button 'apropos-symbol)))))
|
||||
(dolist (var-bt '(apropos-variable apropos-user-option))
|
||||
(button-type-put
|
||||
var-bt 'action
|
||||
(lambda (button)
|
||||
(helpful-variable (button-get button 'apropos-symbol))))))
|
||||
|
||||
(when EMACS29+
|
||||
;; REVIEW This should be reported upstream to Emacs.
|
||||
(defadvice! doom--find-function-search-for-symbol-save-excursion-a (fn &rest args)
|
||||
"Suppress cursor movement by `find-function-search-for-symbol'.
|
||||
|
||||
Addresses an unwanted side-effect in `find-function-search-for-symbol' on Emacs
|
||||
29 where the cursor is moved to a variable's definition if it's defined in the
|
||||
current buffer."
|
||||
:around #'find-function-search-for-symbol
|
||||
(let (buf pos)
|
||||
(letf! (defun find-library-name (library)
|
||||
(let ((filename (funcall find-library-name library)))
|
||||
(with-current-buffer (find-file-noselect filename)
|
||||
(setq buf (current-buffer)
|
||||
pos (point)))
|
||||
filename))
|
||||
(prog1 (apply fn args)
|
||||
(when (buffer-live-p buf)
|
||||
(with-current-buffer buf (goto-char pos)))))))))
|
||||
|
||||
|
||||
;;;###package imenu
|
||||
(add-hook 'imenu-after-jump-hook #'recenter)
|
||||
|
||||
|
||||
(use-package! smartparens
|
||||
;; Auto-close delimiters and blocks as you type. It's more powerful than that,
|
||||
;; but that is all Doom uses it for.
|
||||
:hook (doom-first-buffer . smartparens-global-mode)
|
||||
:commands sp-pair sp-local-pair sp-with-modes sp-point-in-comment sp-point-in-string
|
||||
:config
|
||||
(add-to-list 'doom-point-in-string-functions 'sp-point-in-string)
|
||||
(add-to-list 'doom-point-in-comment-functions 'sp-point-in-comment)
|
||||
;; smartparens recognizes `slime-mrepl-mode', but not `sly-mrepl-mode', so...
|
||||
(add-to-list 'sp-lisp-modes 'sly-mrepl-mode)
|
||||
;; Load default smartparens rules for various languages
|
||||
(require 'smartparens-config)
|
||||
;; Overlays are too distracting and not terribly helpful. show-parens does
|
||||
;; this for us already (and is faster), so...
|
||||
(setq sp-highlight-pair-overlay nil
|
||||
sp-highlight-wrap-overlay nil
|
||||
sp-highlight-wrap-tag-overlay nil)
|
||||
(with-eval-after-load 'evil
|
||||
;; But if someone does want overlays enabled, evil users will be stricken
|
||||
;; with an off-by-one issue where smartparens assumes you're outside the
|
||||
;; pair when you're really at the last character in insert mode. We must
|
||||
;; correct this vile injustice.
|
||||
(setq sp-show-pair-from-inside t)
|
||||
;; ...and stay highlighted until we've truly escaped the pair!
|
||||
(setq sp-cancel-autoskip-on-backward-movement nil)
|
||||
;; Smartparens conditional binds a key to C-g when sp overlays are active
|
||||
;; (even if they're invisible). This disruptively changes the behavior of
|
||||
;; C-g in insert mode, requiring two presses of the key to exit insert mode.
|
||||
;; I don't see the point of this keybind, so...
|
||||
(setq sp-pair-overlay-keymap (make-sparse-keymap)))
|
||||
|
||||
;; The default is 100, because smartparen's scans are relatively expensive
|
||||
;; (especially with large pair lists for some modes), we reduce it, as a
|
||||
;; better compromise between performance and accuracy.
|
||||
(setq sp-max-prefix-length 25)
|
||||
;; No pair has any business being longer than 4 characters; if they must, set
|
||||
;; it buffer-locally. It's less work for smartparens.
|
||||
(setq sp-max-pair-length 4)
|
||||
|
||||
;; Silence some harmless but annoying echo-area spam
|
||||
(dolist (key '(:unmatched-expression :no-matching-tag))
|
||||
(setf (alist-get key sp-message-alist) nil))
|
||||
|
||||
(add-hook! 'eval-expression-minibuffer-setup-hook
|
||||
(defun doom-init-smartparens-in-eval-expression-h ()
|
||||
"Enable `smartparens-mode' in the minibuffer for `eval-expression'.
|
||||
This includes everything that calls `read--expression', e.g.
|
||||
`edebug-eval-expression' Only enable it if
|
||||
`smartparens-global-mode' is on."
|
||||
(when smartparens-global-mode (smartparens-mode +1))))
|
||||
(add-hook! 'minibuffer-setup-hook
|
||||
(defun doom-init-smartparens-in-minibuffer-maybe-h ()
|
||||
"Enable `smartparens' for non-`eval-expression' commands.
|
||||
Only enable `smartparens-mode' if `smartparens-global-mode' is
|
||||
on."
|
||||
(when (and smartparens-global-mode (memq this-command '(evil-ex)))
|
||||
(smartparens-mode +1))))
|
||||
|
||||
;; You're likely writing lisp in the minibuffer, therefore, disable these
|
||||
;; quote pairs, which lisps doesn't use for strings:
|
||||
(sp-local-pair '(minibuffer-mode minibuffer-inactive-mode) "'" nil :actions nil)
|
||||
(sp-local-pair '(minibuffer-mode minibuffer-inactive-mode) "`" nil :actions nil)
|
||||
|
||||
;; Smartparens breaks evil-mode's replace state
|
||||
(defvar doom-buffer-smartparens-mode nil)
|
||||
(add-hook! 'evil-replace-state-exit-hook
|
||||
(defun doom-enable-smartparens-mode-maybe-h ()
|
||||
(when doom-buffer-smartparens-mode
|
||||
(turn-on-smartparens-mode)
|
||||
(kill-local-variable 'doom-buffer-smartparens-mode))))
|
||||
(add-hook! 'evil-replace-state-entry-hook
|
||||
(defun doom-disable-smartparens-mode-maybe-h ()
|
||||
(when smartparens-mode
|
||||
(setq-local doom-buffer-smartparens-mode t)
|
||||
(turn-off-smartparens-mode)))))
|
||||
|
||||
|
||||
(use-package! so-long
|
||||
:hook (doom-first-file . global-so-long-mode)
|
||||
:config
|
||||
;; Emacs 29 introduced faster long-line detection, so they can afford a much
|
||||
;; larger `so-long-threshold' and its default `so-long-predicate'.
|
||||
(if (fboundp 'buffer-line-statistics)
|
||||
(unless NATIVECOMP
|
||||
(setq so-long-threshold 5000))
|
||||
;; reduce false positives w/ larger threshold
|
||||
(setq so-long-threshold 400)
|
||||
|
||||
(defun doom-buffer-has-long-lines-p ()
|
||||
(unless (bound-and-true-p visual-line-mode)
|
||||
(let ((so-long-skip-leading-comments
|
||||
;; HACK Fix #2183: `so-long-detected-long-line-p' calls
|
||||
;; `comment-forward' which tries to use comment syntax, which
|
||||
;; throws an error if comment state isn't initialized, leading
|
||||
;; to a wrong-type-argument: stringp error.
|
||||
;; DEPRECATED Fixed in Emacs 28.
|
||||
(bound-and-true-p comment-use-syntax)))
|
||||
(so-long-detected-long-line-p))))
|
||||
(setq so-long-predicate #'doom-buffer-has-long-lines-p))
|
||||
;; Don't disable syntax highlighting and line numbers, or make the buffer
|
||||
;; read-only, in `so-long-minor-mode', so we can have a basic editing
|
||||
;; experience in them, at least. It will remain off in `so-long-mode',
|
||||
;; however, because long files have a far bigger impact on Emacs performance.
|
||||
(delq! 'font-lock-mode so-long-minor-modes)
|
||||
(delq! 'display-line-numbers-mode so-long-minor-modes)
|
||||
(delq! 'buffer-read-only so-long-variable-overrides 'assq)
|
||||
;; ...but at least reduce the level of syntax highlighting
|
||||
(add-to-list 'so-long-variable-overrides '(font-lock-maximum-decoration . 1))
|
||||
;; ...and insist that save-place not operate in large/long files
|
||||
(add-to-list 'so-long-variable-overrides '(save-place-alist . nil))
|
||||
;; But disable everything else that may be unnecessary/expensive for large or
|
||||
;; wide buffers.
|
||||
(appendq! so-long-minor-modes
|
||||
'(spell-fu-mode
|
||||
eldoc-mode
|
||||
highlight-numbers-mode
|
||||
better-jumper-local-mode
|
||||
ws-butler-mode
|
||||
auto-composition-mode
|
||||
undo-tree-mode
|
||||
highlight-indent-guides-mode
|
||||
hl-fill-column-mode
|
||||
;; These are redundant on Emacs 29+
|
||||
flycheck-mode
|
||||
smartparens-mode
|
||||
smartparens-strict-mode)))
|
||||
|
||||
|
||||
(use-package! ws-butler
|
||||
;; a less intrusive `delete-trailing-whitespaces' on save
|
||||
:hook (doom-first-buffer . ws-butler-global-mode)
|
||||
:config
|
||||
;; ws-butler normally preserves whitespace in the buffer (but strips it from
|
||||
;; the written file). While sometimes convenient, this behavior is not
|
||||
;; intuitive. To the average user it looks like whitespace cleanup is failing,
|
||||
;; which causes folks to redundantly install their own.
|
||||
(setq ws-butler-keep-whitespace-before-point nil))
|
||||
|
||||
(provide 'doom-editor)
|
||||
;;; doom-editor.el ends here
|
||||
462
lisp/doom-keybinds.el
Normal file
462
lisp/doom-keybinds.el
Normal file
|
|
@ -0,0 +1,462 @@
|
|||
;;; doom-keybinds.el -*- lexical-binding: t; -*-
|
||||
|
||||
;; A centralized keybinds system, integrated with `which-key' to preview
|
||||
;; available keybindings. All built into one powerful macro: `map!'. If evil is
|
||||
;; never loaded, then evil bindings set with `map!' are ignored (i.e. omitted
|
||||
;; entirely for performance reasons).
|
||||
|
||||
(defvar doom-leader-key "SPC"
|
||||
"The leader prefix key for Evil users.")
|
||||
|
||||
(defvar doom-leader-alt-key "M-SPC"
|
||||
"An alternative leader prefix key, used for Insert and Emacs states, and for
|
||||
non-evil users.")
|
||||
|
||||
(defvar doom-localleader-key "SPC m"
|
||||
"The localleader prefix key, for major-mode specific commands.")
|
||||
|
||||
(defvar doom-localleader-alt-key "M-SPC m"
|
||||
"The localleader prefix key, for major-mode specific commands. Used for Insert
|
||||
and Emacs states, and for non-evil users.")
|
||||
|
||||
(defvar doom-leader-map (make-sparse-keymap)
|
||||
"An overriding keymap for <leader> keys.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Keybind settings
|
||||
|
||||
(cond
|
||||
(IS-MAC
|
||||
;; mac-* variables are used by the special emacs-mac build of Emacs by
|
||||
;; Yamamoto Mitsuharu, while other builds use ns-*.
|
||||
(setq mac-command-modifier 'super
|
||||
ns-command-modifier 'super
|
||||
mac-option-modifier 'meta
|
||||
ns-option-modifier 'meta
|
||||
;; Free up the right option for character composition
|
||||
mac-right-option-modifier 'none
|
||||
ns-right-option-modifier 'none))
|
||||
(IS-WINDOWS
|
||||
(setq w32-lwindow-modifier 'super
|
||||
w32-rwindow-modifier 'super)))
|
||||
|
||||
;; HACK Fixes Emacs' disturbing inability to distinguish C-i from TAB.
|
||||
(define-key key-translation-map [?\C-i]
|
||||
(cmd! (if (let ((keys (this-single-command-raw-keys)))
|
||||
(and keys
|
||||
(not (cl-position 'tab keys))
|
||||
(not (cl-position 'kp-tab keys))
|
||||
(display-graphic-p)
|
||||
;; Fall back if no <C-i> keybind can be found, otherwise
|
||||
;; we've broken all pre-existing C-i keybinds.
|
||||
(let ((key
|
||||
(doom-lookup-key
|
||||
(vconcat (cl-subseq keys 0 -1) [C-i]))))
|
||||
(not (or (numberp key) (null key))))))
|
||||
[C-i] [?\C-i])))
|
||||
|
||||
|
||||
;;
|
||||
;;; Universal, non-nuclear escape
|
||||
|
||||
;; `keyboard-quit' is too much of a nuclear option. I wanted an ESC/C-g to
|
||||
;; do-what-I-mean. It serves four purposes (in order):
|
||||
;;
|
||||
;; 1. Quit active states; e.g. highlights, searches, snippets, iedit,
|
||||
;; multiple-cursors, recording macros, etc.
|
||||
;; 2. Close popup windows remotely (if it is allowed to)
|
||||
;; 3. Refresh buffer indicators, like git-gutter and flycheck
|
||||
;; 4. Or fall back to `keyboard-quit'
|
||||
;;
|
||||
;; And it should do these things incrementally, rather than all at once. And it
|
||||
;; shouldn't interfere with recording macros or the minibuffer. This may require
|
||||
;; you press ESC/C-g two or three times on some occasions to reach
|
||||
;; `keyboard-quit', but this is much more intuitive.
|
||||
|
||||
(defvar doom-escape-hook nil
|
||||
"A hook run when C-g is pressed (or ESC in normal mode, for evil users).
|
||||
|
||||
More specifically, when `doom/escape' is pressed. If any hook returns non-nil,
|
||||
all hooks after it are ignored.")
|
||||
|
||||
(defun doom/escape (&optional interactive)
|
||||
"Run `doom-escape-hook'."
|
||||
(interactive (list 'interactive))
|
||||
(cond ((minibuffer-window-active-p (minibuffer-window))
|
||||
;; quit the minibuffer if open.
|
||||
(when interactive
|
||||
(setq this-command 'abort-recursive-edit))
|
||||
(abort-recursive-edit))
|
||||
;; Run all escape hooks. If any returns non-nil, then stop there.
|
||||
((run-hook-with-args-until-success 'doom-escape-hook))
|
||||
;; don't abort macros
|
||||
((or defining-kbd-macro executing-kbd-macro) nil)
|
||||
;; Back to the default
|
||||
((unwind-protect (keyboard-quit)
|
||||
(when interactive
|
||||
(setq this-command 'keyboard-quit))))))
|
||||
|
||||
(global-set-key [remap keyboard-quit] #'doom/escape)
|
||||
|
||||
(with-eval-after-load 'eldoc
|
||||
(eldoc-add-command 'doom/escape))
|
||||
|
||||
|
||||
;;
|
||||
;;; General + leader/localleader keys
|
||||
|
||||
(use-package general
|
||||
:init
|
||||
;; Convenience aliases
|
||||
(defalias 'define-key! #'general-def)
|
||||
(defalias 'undefine-key! #'general-unbind)
|
||||
:config
|
||||
;; Prevent "X starts with non-prefix key Y" errors except at startup.
|
||||
(add-hook 'doom-after-init-modules-hook #'general-auto-unbind-keys))
|
||||
|
||||
|
||||
;; HACK `map!' uses this instead of `define-leader-key!' because it consumes
|
||||
;; 20-30% more startup time, so we reimplement it ourselves.
|
||||
(defmacro doom--define-leader-key (&rest keys)
|
||||
(let (prefix forms wkforms)
|
||||
(while keys
|
||||
(let ((key (pop keys))
|
||||
(def (pop keys)))
|
||||
(if (keywordp key)
|
||||
(when (memq key '(:prefix :infix))
|
||||
(setq prefix def))
|
||||
(when prefix
|
||||
(setq key `(general--concat t ,prefix ,key)))
|
||||
(let* ((udef (cdr-safe (doom-unquote def)))
|
||||
(bdef (if (general--extended-def-p udef)
|
||||
(general--extract-def (general--normalize-extended-def udef))
|
||||
def)))
|
||||
(unless (eq bdef :ignore)
|
||||
(push `(define-key doom-leader-map (general--kbd ,key)
|
||||
,bdef)
|
||||
forms))
|
||||
(when-let (desc (cadr (memq :which-key udef)))
|
||||
(prependq!
|
||||
wkforms `((which-key-add-key-based-replacements
|
||||
(general--concat t doom-leader-alt-key ,key)
|
||||
,desc)
|
||||
(which-key-add-key-based-replacements
|
||||
(general--concat t doom-leader-key ,key)
|
||||
,desc))))))))
|
||||
(macroexp-progn
|
||||
(append (and wkforms `((after! which-key ,@(nreverse wkforms))))
|
||||
(nreverse forms)))))
|
||||
|
||||
(defmacro define-leader-key! (&rest args)
|
||||
"Define <leader> keys.
|
||||
|
||||
Uses `general-define-key' under the hood, but does not support :states,
|
||||
:wk-full-keys or :keymaps. Use `map!' for a more convenient interface.
|
||||
|
||||
See `doom-leader-key' and `doom-leader-alt-key' to change the leader prefix."
|
||||
`(general-define-key
|
||||
:states nil
|
||||
:wk-full-keys nil
|
||||
:keymaps 'doom-leader-map
|
||||
,@args))
|
||||
|
||||
(defmacro define-localleader-key! (&rest args)
|
||||
"Define <localleader> key.
|
||||
|
||||
Uses `general-define-key' under the hood, but does not support :major-modes,
|
||||
:states, :prefix or :non-normal-prefix. Use `map!' for a more convenient
|
||||
interface.
|
||||
|
||||
See `doom-localleader-key' and `doom-localleader-alt-key' to change the
|
||||
localleader prefix."
|
||||
(if (featurep! :editor evil)
|
||||
;; :non-normal-prefix doesn't apply to non-evil sessions (only evil's
|
||||
;; emacs state)
|
||||
`(general-define-key
|
||||
:states '(normal visual motion emacs insert)
|
||||
:major-modes t
|
||||
:prefix doom-localleader-key
|
||||
:non-normal-prefix doom-localleader-alt-key
|
||||
,@args)
|
||||
`(general-define-key
|
||||
:major-modes t
|
||||
:prefix doom-localleader-alt-key
|
||||
,@args)))
|
||||
|
||||
;; We use a prefix commands instead of general's :prefix/:non-normal-prefix
|
||||
;; properties because general is incredibly slow binding keys en mass with them
|
||||
;; in conjunction with :states -- an effective doubling of Doom's startup time!
|
||||
(define-prefix-command 'doom/leader 'doom-leader-map)
|
||||
(define-key doom-leader-map [override-state] 'all)
|
||||
|
||||
;; Bind `doom-leader-key' and `doom-leader-alt-key' as late as possible to give
|
||||
;; the user a chance to modify them.
|
||||
(add-hook! 'doom-after-init-modules-hook
|
||||
(defun doom-init-leader-keys-h ()
|
||||
"Bind `doom-leader-key' and `doom-leader-alt-key'."
|
||||
(let ((map general-override-mode-map))
|
||||
(if (not (featurep 'evil))
|
||||
(progn
|
||||
(cond ((equal doom-leader-alt-key "C-c")
|
||||
(set-keymap-parent doom-leader-map mode-specific-map))
|
||||
((equal doom-leader-alt-key "C-x")
|
||||
(set-keymap-parent doom-leader-map ctl-x-map)))
|
||||
(define-key map (kbd doom-leader-alt-key) 'doom/leader))
|
||||
(evil-define-key* '(normal visual motion) map (kbd doom-leader-key) 'doom/leader)
|
||||
(evil-define-key* '(emacs insert) map (kbd doom-leader-alt-key) 'doom/leader))
|
||||
(general-override-mode +1))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Packages
|
||||
|
||||
(use-package! which-key
|
||||
:hook (doom-first-input . which-key-mode)
|
||||
:init
|
||||
(setq which-key-sort-order #'which-key-key-order-alpha
|
||||
which-key-sort-uppercase-first nil
|
||||
which-key-add-column-padding 1
|
||||
which-key-max-display-columns nil
|
||||
which-key-min-display-lines 6
|
||||
which-key-side-window-slot -10)
|
||||
:config
|
||||
(put 'which-key-replacement-alist 'initial-value which-key-replacement-alist)
|
||||
(add-hook! 'doom-before-reload-hook
|
||||
(defun doom-reset-which-key-replacements-h ()
|
||||
(setq which-key-replacement-alist (get 'which-key-replacement-alist 'initial-value))))
|
||||
;; general improvements to which-key readability
|
||||
(which-key-setup-side-window-bottom)
|
||||
(setq-hook! 'which-key-init-buffer-hook line-spacing 3)
|
||||
|
||||
(which-key-add-key-based-replacements doom-leader-key "<leader>")
|
||||
(which-key-add-key-based-replacements doom-localleader-key "<localleader>"))
|
||||
|
||||
|
||||
;;
|
||||
;;; `map!' macro
|
||||
|
||||
(defvar doom-evil-state-alist
|
||||
'((?n . normal)
|
||||
(?v . visual)
|
||||
(?i . insert)
|
||||
(?e . emacs)
|
||||
(?o . operator)
|
||||
(?m . motion)
|
||||
(?r . replace)
|
||||
(?g . global))
|
||||
"A list of cons cells that map a letter to a evil state symbol.")
|
||||
|
||||
(defun doom--map-keyword-to-states (keyword)
|
||||
"Convert a KEYWORD into a list of evil state symbols.
|
||||
|
||||
For example, :nvi will map to (list 'normal 'visual 'insert). See
|
||||
`doom-evil-state-alist' to customize this."
|
||||
(cl-loop for l across (doom-keyword-name keyword)
|
||||
if (assq l doom-evil-state-alist) collect (cdr it)
|
||||
else do (error "not a valid state: %s" l)))
|
||||
|
||||
|
||||
;; specials
|
||||
(defvar doom--map-forms nil)
|
||||
(defvar doom--map-fn nil)
|
||||
(defvar doom--map-batch-forms nil)
|
||||
(defvar doom--map-state '(:dummy t))
|
||||
(defvar doom--map-parent-state nil)
|
||||
(defvar doom--map-evil-p nil)
|
||||
(after! evil (setq doom--map-evil-p t))
|
||||
|
||||
(defun doom--map-process (rest)
|
||||
(let ((doom--map-fn doom--map-fn)
|
||||
doom--map-state
|
||||
doom--map-forms
|
||||
desc)
|
||||
(while rest
|
||||
(let ((key (pop rest)))
|
||||
(cond ((listp key)
|
||||
(doom--map-nested nil key))
|
||||
|
||||
((keywordp key)
|
||||
(pcase key
|
||||
(:leader
|
||||
(doom--map-commit)
|
||||
(setq doom--map-fn 'doom--define-leader-key))
|
||||
(:localleader
|
||||
(doom--map-commit)
|
||||
(setq doom--map-fn 'define-localleader-key!))
|
||||
(:after
|
||||
(doom--map-nested (list 'after! (pop rest)) rest)
|
||||
(setq rest nil))
|
||||
(:desc
|
||||
(setq desc (pop rest)))
|
||||
(:map
|
||||
(doom--map-set :keymaps `(quote ,(doom-enlist (pop rest)))))
|
||||
(:mode
|
||||
(push (cl-loop for m in (doom-enlist (pop rest))
|
||||
collect (intern (concat (symbol-name m) "-map")))
|
||||
rest)
|
||||
(push :map rest))
|
||||
((or :when :unless)
|
||||
(doom--map-nested (list (intern (doom-keyword-name key)) (pop rest)) rest)
|
||||
(setq rest nil))
|
||||
(:prefix-map
|
||||
(cl-destructuring-bind (prefix . desc)
|
||||
(let ((arg (pop rest)))
|
||||
(if (consp arg) arg (list arg)))
|
||||
(let ((keymap (intern (format "doom-leader-%s-map" desc))))
|
||||
(setq rest
|
||||
(append (list :desc desc prefix keymap
|
||||
:prefix prefix)
|
||||
rest))
|
||||
(push `(defvar ,keymap (make-sparse-keymap))
|
||||
doom--map-forms))))
|
||||
(:prefix
|
||||
(cl-destructuring-bind (prefix . desc)
|
||||
(let ((arg (pop rest)))
|
||||
(if (consp arg) arg (list arg)))
|
||||
(doom--map-set (if doom--map-fn :infix :prefix)
|
||||
prefix)
|
||||
(when (stringp desc)
|
||||
(setq rest (append (list :desc desc "" nil) rest)))))
|
||||
(:textobj
|
||||
(let* ((key (pop rest))
|
||||
(inner (pop rest))
|
||||
(outer (pop rest)))
|
||||
(push `(map! (:map evil-inner-text-objects-map ,key ,inner)
|
||||
(:map evil-outer-text-objects-map ,key ,outer))
|
||||
doom--map-forms)))
|
||||
(_
|
||||
(condition-case _
|
||||
(doom--map-def (pop rest) (pop rest)
|
||||
(doom--map-keyword-to-states key)
|
||||
desc)
|
||||
(error
|
||||
(error "Not a valid `map!' property: %s" key)))
|
||||
(setq desc nil))))
|
||||
|
||||
((doom--map-def key (pop rest) nil desc)
|
||||
(setq desc nil)))))
|
||||
|
||||
(doom--map-commit)
|
||||
(macroexp-progn (nreverse (delq nil doom--map-forms)))))
|
||||
|
||||
(defun doom--map-append-keys (prop)
|
||||
(let ((a (plist-get doom--map-parent-state prop))
|
||||
(b (plist-get doom--map-state prop)))
|
||||
(if (and a b)
|
||||
`(general--concat t ,a ,b)
|
||||
(or a b))))
|
||||
|
||||
(defun doom--map-nested (wrapper rest)
|
||||
(doom--map-commit)
|
||||
(let ((doom--map-parent-state (doom--map-state)))
|
||||
(push (if wrapper
|
||||
(append wrapper (list (doom--map-process rest)))
|
||||
(doom--map-process rest))
|
||||
doom--map-forms)))
|
||||
|
||||
(defun doom--map-set (prop &optional value)
|
||||
(unless (equal (plist-get doom--map-state prop) value)
|
||||
(doom--map-commit))
|
||||
(setq doom--map-state (plist-put doom--map-state prop value)))
|
||||
|
||||
(defun doom--map-def (key def &optional states desc)
|
||||
(when (or (memq 'global states)
|
||||
(null states))
|
||||
(setq states (cons 'nil (delq 'global states))))
|
||||
(when desc
|
||||
(let (unquoted)
|
||||
(cond ((and (listp def)
|
||||
(keywordp (car-safe (setq unquoted (doom-unquote def)))))
|
||||
(setq def (list 'quote (plist-put unquoted :which-key desc))))
|
||||
((setq def (cons 'list
|
||||
(if (and (equal key "")
|
||||
(null def))
|
||||
`(:ignore t :which-key ,desc)
|
||||
(plist-put (general--normalize-extended-def def)
|
||||
:which-key desc))))))))
|
||||
(dolist (state states)
|
||||
(push (list key def)
|
||||
(alist-get state doom--map-batch-forms)))
|
||||
t)
|
||||
|
||||
(defun doom--map-commit ()
|
||||
(when doom--map-batch-forms
|
||||
(cl-loop with attrs = (doom--map-state)
|
||||
for (state . defs) in doom--map-batch-forms
|
||||
if (or doom--map-evil-p (not state))
|
||||
collect `(,(or doom--map-fn 'general-define-key)
|
||||
,@(if state `(:states ',state)) ,@attrs
|
||||
,@(mapcan #'identity (nreverse defs)))
|
||||
into forms
|
||||
finally do (push (macroexp-progn forms) doom--map-forms))
|
||||
(setq doom--map-batch-forms nil)))
|
||||
|
||||
(defun doom--map-state ()
|
||||
(let ((plist
|
||||
(append (list :prefix (doom--map-append-keys :prefix)
|
||||
:infix (doom--map-append-keys :infix)
|
||||
:keymaps
|
||||
(append (plist-get doom--map-parent-state :keymaps)
|
||||
(plist-get doom--map-state :keymaps)))
|
||||
doom--map-state
|
||||
nil))
|
||||
newplist)
|
||||
(while plist
|
||||
(let ((key (pop plist))
|
||||
(val (pop plist)))
|
||||
(when (and val (not (plist-member newplist key)))
|
||||
(push val newplist)
|
||||
(push key newplist))))
|
||||
newplist))
|
||||
|
||||
;;
|
||||
(defmacro map! (&rest rest)
|
||||
"A convenience macro for defining keybinds, powered by `general'.
|
||||
|
||||
If evil isn't loaded, evil-specific bindings are ignored.
|
||||
|
||||
Properties
|
||||
:leader [...] an alias for (:prefix doom-leader-key ...)
|
||||
:localleader [...] bind to localleader; requires a keymap
|
||||
:mode [MODE(s)] [...] inner keybinds are applied to major MODE(s)
|
||||
:map [KEYMAP(s)] [...] inner keybinds are applied to KEYMAP(S)
|
||||
:prefix [PREFIX] [...] set keybind prefix for following keys. PREFIX
|
||||
can be a cons cell: (PREFIX . DESCRIPTION)
|
||||
:prefix-map [PREFIX] [...] same as :prefix, but defines a prefix keymap
|
||||
where the following keys will be bound. DO NOT
|
||||
USE THIS IN YOUR PRIVATE CONFIG.
|
||||
:after [FEATURE] [...] apply keybinds when [FEATURE] loads
|
||||
:textobj KEY INNER-FN OUTER-FN define a text object keybind pair
|
||||
:when [CONDITION] [...]
|
||||
:unless [CONDITION] [...]
|
||||
|
||||
Any of the above properties may be nested, so that they only apply to a
|
||||
certain group of keybinds.
|
||||
|
||||
States
|
||||
:n normal
|
||||
:v visual
|
||||
:i insert
|
||||
:e emacs
|
||||
:o operator
|
||||
:m motion
|
||||
:r replace
|
||||
:g global (binds the key without evil `current-global-map')
|
||||
|
||||
These can be combined in any order, e.g. :nvi will apply to normal, visual and
|
||||
insert mode. The state resets after the following key=>def pair. If states are
|
||||
omitted the keybind will be global (no emacs state; this is different from
|
||||
evil's Emacs state and will work in the absence of `evil-mode').
|
||||
|
||||
These must be placed right before the key string.
|
||||
|
||||
Do
|
||||
(map! :leader :desc \"Description\" :n \"C-c\" #'dosomething)
|
||||
Don't
|
||||
(map! :n :leader :desc \"Description\" \"C-c\" #'dosomething)
|
||||
(map! :leader :n :desc \"Description\" \"C-c\" #'dosomething)"
|
||||
(doom--map-process rest))
|
||||
|
||||
(provide 'doom-keybinds)
|
||||
;;; doom-keybinds.el ends here
|
||||
817
lisp/doom-lib.el
Normal file
817
lisp/doom-lib.el
Normal file
|
|
@ -0,0 +1,817 @@
|
|||
;;; doom-lib.el -*- lexical-binding: t; -*-
|
||||
|
||||
(require 'cl-lib)
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(defun doom--resolve-hook-forms (hooks)
|
||||
"Converts a list of modes into a list of hook symbols.
|
||||
|
||||
If a mode is quoted, it is left as is. If the entire HOOKS list is quoted, the
|
||||
list is returned as-is."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(let ((hook-list (doom-enlist (doom-unquote hooks))))
|
||||
(if (eq (car-safe hooks) 'quote)
|
||||
hook-list
|
||||
(cl-loop for hook in hook-list
|
||||
if (eq (car-safe hook) 'quote)
|
||||
collect (cadr hook)
|
||||
else collect (intern (format "%s-hook" (symbol-name hook)))))))
|
||||
|
||||
(defun doom--setq-hook-fns (hooks rest &optional singles)
|
||||
(unless (or singles (= 0 (% (length rest) 2)))
|
||||
(signal 'wrong-number-of-arguments (list #'evenp (length rest))))
|
||||
(cl-loop with vars = (let ((args rest)
|
||||
vars)
|
||||
(while args
|
||||
(push (if singles
|
||||
(list (pop args))
|
||||
(cons (pop args) (pop args)))
|
||||
vars))
|
||||
(nreverse vars))
|
||||
for hook in (doom--resolve-hook-forms hooks)
|
||||
for mode = (string-remove-suffix "-hook" (symbol-name hook))
|
||||
append
|
||||
(cl-loop for (var . val) in vars
|
||||
collect
|
||||
(list var val hook
|
||||
(intern (format "doom--setq-%s-for-%s-h"
|
||||
var mode))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Public library
|
||||
|
||||
(define-obsolete-function-alias 'doom-enlist 'ensure-list "v3.0.0")
|
||||
|
||||
(defun doom-unquote (exp)
|
||||
"Return EXP unquoted."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(while (memq (car-safe exp) '(quote function))
|
||||
(setq exp (cadr exp)))
|
||||
exp)
|
||||
|
||||
(defun doom-enlist (exp)
|
||||
"Return EXP wrapped in a list, or as-is if already a list."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(if (proper-list-p exp) exp (list exp)))
|
||||
|
||||
(defun doom-keyword-intern (str)
|
||||
"Converts STR (a string) into a keyword (`keywordp')."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(cl-check-type str string)
|
||||
(intern (concat ":" str)))
|
||||
|
||||
(defun doom-keyword-name (keyword)
|
||||
"Returns the string name of KEYWORD (`keywordp') minus the leading colon."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(cl-check-type keyword keyword)
|
||||
(substring (symbol-name keyword) 1))
|
||||
|
||||
(defalias 'doom-partial #'apply-partially)
|
||||
|
||||
(defun doom-rpartial (fn &rest args)
|
||||
"Return a partial application of FUN to right-hand ARGS.
|
||||
|
||||
ARGS is a list of the last N arguments to pass to FUN. The result is a new
|
||||
function which does the same as FUN, except that the last N arguments are fixed
|
||||
at the values with which this function was called."
|
||||
(declare (side-effect-free t))
|
||||
(lambda (&rest pre-args)
|
||||
(apply fn (append pre-args args))))
|
||||
|
||||
(defun doom-lookup-key (keys &rest keymaps)
|
||||
"Like `lookup-key', but search active keymaps if KEYMAP is omitted."
|
||||
(if keymaps
|
||||
(cl-some (doom-rpartial #'lookup-key keys) keymaps)
|
||||
(cl-loop for keymap
|
||||
in (append (cl-loop for alist in emulation-mode-map-alists
|
||||
append (mapcar #'cdr
|
||||
(if (symbolp alist)
|
||||
(if (boundp alist) (symbol-value alist))
|
||||
alist)))
|
||||
(list (current-local-map))
|
||||
(mapcar #'cdr minor-mode-overriding-map-alist)
|
||||
(mapcar #'cdr minor-mode-map-alist)
|
||||
(list (current-global-map)))
|
||||
if (keymapp keymap)
|
||||
if (lookup-key keymap keys)
|
||||
return it)))
|
||||
|
||||
(defun doom-load-envvars-file (file &optional noerror)
|
||||
"Read and set envvars from FILE.
|
||||
If NOERROR is non-nil, don't throw an error if the file doesn't exist or is
|
||||
unreadable. Returns the names of envvars that were changed."
|
||||
(if (null (file-exists-p file))
|
||||
(unless noerror
|
||||
(signal 'file-error (list "No envvar file exists" file)))
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(when-let (env (read (current-buffer)))
|
||||
(let ((tz (getenv-internal "TZ")))
|
||||
(setq-default
|
||||
process-environment
|
||||
(append env (default-value 'process-environment))
|
||||
exec-path
|
||||
(append (split-string (getenv "PATH") path-separator t)
|
||||
(list exec-directory))
|
||||
shell-file-name
|
||||
(or (getenv "SHELL")
|
||||
(default-value 'shell-file-name)))
|
||||
(when-let (newtz (getenv-internal "TZ"))
|
||||
(unless (equal tz newtz)
|
||||
(set-time-zone-rule newtz))))
|
||||
env))))
|
||||
|
||||
(defun doom-run-hook (hook)
|
||||
"Run HOOK (a hook function) with better error handling.
|
||||
Meant to be used with `run-hook-wrapped'."
|
||||
(condition-case-unless-debug e
|
||||
(funcall hook)
|
||||
(error
|
||||
(signal 'doom-hook-error (list hook e))))
|
||||
;; return nil so `run-hook-wrapped' won't short circuit
|
||||
nil)
|
||||
|
||||
(defun doom-run-hooks (&rest hooks)
|
||||
"Run HOOKS (a list of hook variable symbols) with better error handling.
|
||||
Is used as advice to replace `run-hooks'."
|
||||
(dolist (hook hooks)
|
||||
(condition-case-unless-debug e
|
||||
(run-hook-wrapped hook #'doom-run-hook)
|
||||
(doom-hook-error
|
||||
(unless debug-on-error
|
||||
(lwarn hook :error "Error running hook %S because: %s"
|
||||
(if (symbolp (cadr e))
|
||||
(symbol-name (cadr e))
|
||||
(cadr e))
|
||||
(caddr e)))
|
||||
(signal 'doom-hook-error (cons hook (cdr e)))))))
|
||||
|
||||
(defun doom-run-hook-on (hook-var trigger-hooks)
|
||||
"Configure HOOK-VAR to be invoked exactly once when any of the TRIGGER-HOOKS
|
||||
are invoked *after* Emacs has initialized (to reduce false positives). Once
|
||||
HOOK-VAR is triggered, it is reset to nil.
|
||||
|
||||
HOOK-VAR is a quoted hook.
|
||||
TRIGGER-HOOK is a list of quoted hooks and/or sharp-quoted functions."
|
||||
(dolist (hook trigger-hooks)
|
||||
(let ((fn (intern (format "%s-init-on-%s-h" hook-var hook))))
|
||||
(fset
|
||||
fn (lambda (&rest _)
|
||||
;; Only trigger this after Emacs has initialized.
|
||||
(when (and after-init-time
|
||||
(or (daemonp)
|
||||
;; In some cases, hooks may be lexically unset to
|
||||
;; inhibit them during expensive batch operations on
|
||||
;; buffers (such as when processing buffers
|
||||
;; internally). In these cases we should assume this
|
||||
;; hook wasn't invoked interactively.
|
||||
(and (boundp hook)
|
||||
(symbol-value hook))))
|
||||
(doom-run-hooks hook-var)
|
||||
(set hook-var nil))))
|
||||
(cond ((daemonp)
|
||||
;; In a daemon session we don't need all these lazy loading
|
||||
;; shenanigans. Just load everything immediately.
|
||||
(add-hook 'after-init-hook fn 'append))
|
||||
((eq hook 'find-file-hook)
|
||||
;; Advise `after-find-file' instead of using `find-file-hook'
|
||||
;; because the latter is triggered too late (after the file has
|
||||
;; opened and modes are all set up).
|
||||
(advice-add 'after-find-file :before fn '((depth . -101))))
|
||||
((add-hook hook fn -101)))
|
||||
fn)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Sugars
|
||||
|
||||
(defun dir! ()
|
||||
"Returns the directory of the emacs lisp file this function is called from."
|
||||
(when-let (path (file!))
|
||||
(directory-file-name (file-name-directory path))))
|
||||
|
||||
(defun file! ()
|
||||
"Return the emacs lisp file this function is called from."
|
||||
(cond (load-in-progress load-file-name)
|
||||
((bound-and-true-p byte-compile-current-file))
|
||||
((stringp (car-safe current-load-list))
|
||||
(car current-load-list))
|
||||
(buffer-file-name)
|
||||
((error "Cannot get this file-path"))))
|
||||
|
||||
(defmacro letenv! (envvars &rest body)
|
||||
"Lexically bind ENVVARS in BODY, like `let' but for `process-environment'."
|
||||
(declare (indent 1))
|
||||
`(let ((process-environment (copy-sequence process-environment)))
|
||||
,@(cl-loop for (var val) in envvars
|
||||
collect `(setenv ,var ,val))
|
||||
,@body))
|
||||
|
||||
(defmacro letf! (bindings &rest body)
|
||||
"Temporarily rebind function, macros, and advice in BODY.
|
||||
|
||||
Intended as syntax sugar for `cl-letf', `cl-labels', `cl-macrolet', and
|
||||
temporary advice.
|
||||
|
||||
BINDINGS is either:
|
||||
|
||||
A list of, or a single, `defun', `defun*', `defmacro', or `defadvice' forms.
|
||||
A list of (PLACE VALUE) bindings as `cl-letf*' would accept.
|
||||
|
||||
TYPE is one of:
|
||||
|
||||
`defun' (uses `cl-letf')
|
||||
`defun*' (uses `cl-labels'; allows recursive references),
|
||||
`defmacro' (uses `cl-macrolet')
|
||||
`defadvice' (uses `defadvice!' before BODY, then `undefadvice!' after)
|
||||
|
||||
NAME, ARGLIST, and BODY are the same as `defun', `defun*', `defmacro', and
|
||||
`defadvice!', respectively.
|
||||
|
||||
\(fn ((TYPE NAME ARGLIST &rest BODY) ...) BODY...)"
|
||||
(declare (indent defun))
|
||||
(setq body (macroexp-progn body))
|
||||
(when (memq (car bindings) '(defun defun* defmacro defadvice))
|
||||
(setq bindings (list bindings)))
|
||||
(dolist (binding (reverse bindings) body)
|
||||
(let ((type (car binding))
|
||||
(rest (cdr binding)))
|
||||
(setq
|
||||
body (pcase type
|
||||
(`defmacro `(cl-macrolet ((,@rest)) ,body))
|
||||
(`defadvice `(progn (defadvice! ,@rest)
|
||||
(unwind-protect ,body (undefadvice! ,@rest))))
|
||||
((or `defun `defun*)
|
||||
`(cl-letf ((,(car rest) (symbol-function #',(car rest))))
|
||||
(ignore ,(car rest))
|
||||
,(if (eq type 'defun*)
|
||||
`(cl-labels ((,@rest)) ,body)
|
||||
`(cl-letf (((symbol-function #',(car rest))
|
||||
(lambda! ,(cadr rest) ,@(cddr rest))))
|
||||
,body))))
|
||||
(_
|
||||
(when (eq (car-safe type) 'function)
|
||||
(setq type (list 'symbol-function type)))
|
||||
(list 'cl-letf (list (cons type rest)) body)))))))
|
||||
|
||||
(defmacro quiet! (&rest forms)
|
||||
"Run FORMS without generating any output.
|
||||
|
||||
This silences calls to `message', `load', `write-region' and anything that
|
||||
writes to `standard-output'. In interactive sessions this inhibits output to the
|
||||
echo-area, but not to *Messages*."
|
||||
`(if init-file-debug
|
||||
(progn ,@forms)
|
||||
,(if noninteractive
|
||||
`(letf! ((standard-output (lambda (&rest _)))
|
||||
(defun message (&rest _))
|
||||
(defun load (file &optional noerror nomessage nosuffix must-suffix)
|
||||
(funcall load file noerror t nosuffix must-suffix))
|
||||
(defun write-region (start end filename &optional append visit lockname mustbenew)
|
||||
(unless visit (setq visit 'no-message))
|
||||
(funcall write-region start end filename append visit lockname mustbenew)))
|
||||
,@forms)
|
||||
`(let ((inhibit-message t)
|
||||
(save-silently t))
|
||||
(prog1 ,@forms (message ""))))))
|
||||
|
||||
(defmacro eval-if! (cond then &rest body)
|
||||
"Expands to THEN if COND is non-nil, to BODY otherwise.
|
||||
COND is checked at compile/expansion time, allowing BODY to be omitted entirely
|
||||
when the elisp is byte-compiled. Use this for forms that contain expensive
|
||||
macros that could safely be removed at compile time."
|
||||
(declare (indent 2))
|
||||
(if (eval cond)
|
||||
then
|
||||
(macroexp-progn body)))
|
||||
|
||||
(defmacro eval-when! (cond &rest body)
|
||||
"Expands to BODY if CONDITION is non-nil at compile/expansion time.
|
||||
See `eval-if!' for details on this macro's purpose."
|
||||
(declare (indent 1))
|
||||
(when (eval cond)
|
||||
(macroexp-progn body)))
|
||||
|
||||
|
||||
;;; Closure factories
|
||||
(defmacro lambda! (arglist &rest body)
|
||||
"Returns (cl-function (lambda ARGLIST BODY...))
|
||||
The closure is wrapped in `cl-function', meaning ARGLIST will accept anything
|
||||
`cl-defun' will. Implicitly adds `&allow-other-keys' if `&key' is present in
|
||||
ARGLIST."
|
||||
(declare (indent defun) (doc-string 1) (pure t) (side-effect-free t))
|
||||
`(cl-function
|
||||
(lambda
|
||||
,(letf! (defun* allow-other-keys (args)
|
||||
(mapcar
|
||||
(lambda (arg)
|
||||
(cond ((nlistp (cdr-safe arg)) arg)
|
||||
((listp arg) (allow-other-keys arg))
|
||||
(arg)))
|
||||
(if (and (memq '&key args)
|
||||
(not (memq '&allow-other-keys args)))
|
||||
(if (memq '&aux args)
|
||||
(let (newargs arg)
|
||||
(while args
|
||||
(setq arg (pop args))
|
||||
(when (eq arg '&aux)
|
||||
(push '&allow-other-keys newargs))
|
||||
(push arg newargs))
|
||||
(nreverse newargs))
|
||||
(append args (list '&allow-other-keys)))
|
||||
args)))
|
||||
(allow-other-keys arglist))
|
||||
,@body)))
|
||||
|
||||
(put 'doom--fn-crawl 'lookup-table
|
||||
'((_ . 0) (_ . 1) (%2 . 2) (%3 . 3) (%4 . 4)
|
||||
(%5 . 5) (%6 . 6) (%7 . 7) (%8 . 8) (%9 . 9)))
|
||||
(defun doom--fn-crawl (data args)
|
||||
(cond ((symbolp data)
|
||||
(when-let
|
||||
(pos (cond ((eq data '%*) 0)
|
||||
((memq data '(% %1)) 1)
|
||||
((cdr (assq data (get 'doom--fn-crawl 'lookup-table))))))
|
||||
(when (and (= pos 1)
|
||||
(aref args 1)
|
||||
(not (eq data (aref args 1))))
|
||||
(error "%% and %%1 are mutually exclusive"))
|
||||
(aset args pos data)))
|
||||
((and (not (eq (car-safe data) '!))
|
||||
(or (listp data)
|
||||
(vectorp data)))
|
||||
(let ((len (length data))
|
||||
(i 0))
|
||||
(while (< i len)
|
||||
(doom--fn-crawl (elt data i) args)
|
||||
(cl-incf i))))))
|
||||
|
||||
(defmacro fn! (&rest args)
|
||||
"Return an lambda with implicit, positional arguments.
|
||||
|
||||
The function's arguments are determined recursively from ARGS. Each symbol from
|
||||
`%1' through `%9' that appears in ARGS is treated as a positional argument.
|
||||
Missing arguments are named `_%N', which keeps the byte-compiler quiet. `%' is
|
||||
a shorthand for `%1'; only one of these can appear in ARGS. `%*' represents
|
||||
extra `&rest' arguments.
|
||||
|
||||
Instead of:
|
||||
|
||||
(lambda (a _ c &rest d)
|
||||
(if a c (cadr d)))
|
||||
|
||||
you can use this macro and write:
|
||||
|
||||
(fn! (if %1 %3 (cadr %*)))
|
||||
|
||||
which expands to:
|
||||
|
||||
(lambda (%1 _%2 %3 &rest %*)
|
||||
(if %1 %3 (cadr %*)))
|
||||
|
||||
This macro was adapted from llama.el (see https://git.sr.ht/~tarsius/llama),
|
||||
minus font-locking, the outer function call, and minor optimizations."
|
||||
`(lambda ,(let ((argv (make-vector 10 nil)))
|
||||
(doom--fn-crawl args argv)
|
||||
`(,@(let ((i (1- (length argv)))
|
||||
(n -1)
|
||||
sym arglist)
|
||||
(while (> i 0)
|
||||
(setq sym (aref argv i))
|
||||
(unless (and (= n -1) (null sym))
|
||||
(cl-incf n)
|
||||
(push (or sym (intern (format "_%%%d" (1+ n))))
|
||||
arglist))
|
||||
(cl-decf i))
|
||||
arglist)
|
||||
,@(and (aref argv 0) '(&rest %*))))
|
||||
,@args))
|
||||
|
||||
(defmacro cmd! (&rest body)
|
||||
"Returns (lambda () (interactive) ,@body)
|
||||
A factory for quickly producing interaction commands, particularly for keybinds
|
||||
or aliases."
|
||||
(declare (doc-string 1) (pure t) (side-effect-free t))
|
||||
`(lambda (&rest _) (interactive) ,@body))
|
||||
|
||||
(defmacro cmd!! (command &optional prefix-arg &rest args)
|
||||
"Returns a closure that interactively calls COMMAND with ARGS and PREFIX-ARG.
|
||||
Like `cmd!', but allows you to change `current-prefix-arg' or pass arguments to
|
||||
COMMAND. This macro is meant to be used as a target for keybinds (e.g. with
|
||||
`define-key' or `map!')."
|
||||
(declare (doc-string 1) (pure t) (side-effect-free t))
|
||||
`(lambda (arg &rest _) (interactive "P")
|
||||
(let ((current-prefix-arg (or ,prefix-arg arg)))
|
||||
(,(if args
|
||||
#'funcall-interactively
|
||||
#'call-interactively)
|
||||
,command ,@args))))
|
||||
|
||||
(defmacro cmds! (&rest branches)
|
||||
"Returns a dispatcher that runs the a command in BRANCHES.
|
||||
Meant to be used as a target for keybinds (e.g. with `define-key' or `map!').
|
||||
|
||||
BRANCHES is a flat list of CONDITION COMMAND pairs. CONDITION is a lisp form
|
||||
that is evaluated when (and each time) the dispatcher is invoked. If it returns
|
||||
non-nil, COMMAND is invoked, otherwise it falls through to the next pair.
|
||||
|
||||
The last element of BRANCHES can be a COMMANd with no CONDITION. This acts as
|
||||
the fallback if all other conditions fail.
|
||||
|
||||
Otherwise, Emacs will fall through the keybind and search the next keymap for a
|
||||
keybind (as if this keybind never existed).
|
||||
|
||||
See `general-key-dispatch' for what other arguments it accepts in BRANCHES."
|
||||
(declare (doc-string 1))
|
||||
(let ((docstring (if (stringp (car branches)) (pop branches) ""))
|
||||
fallback)
|
||||
(when (cl-oddp (length branches))
|
||||
(setq fallback (car (last branches))
|
||||
branches (butlast branches)))
|
||||
(let ((defs (cl-loop for (key value) on branches by 'cddr
|
||||
unless (keywordp key)
|
||||
collect (list key value))))
|
||||
`'(menu-item
|
||||
,(or docstring "") nil
|
||||
:filter (lambda (&optional _)
|
||||
(let (it)
|
||||
(cond ,@(mapcar (lambda (pred-def)
|
||||
`((setq it ,(car pred-def))
|
||||
,(cadr pred-def)))
|
||||
defs)
|
||||
(t ,fallback))))))))
|
||||
|
||||
(defalias 'kbd! #'general-simulate-key)
|
||||
|
||||
;; For backwards compatibility
|
||||
(defalias 'λ! #'cmd!)
|
||||
(defalias 'λ!! #'cmd!!)
|
||||
|
||||
|
||||
;;; Mutation
|
||||
(defmacro appendq! (sym &rest lists)
|
||||
"Append LISTS to SYM in place."
|
||||
`(setq ,sym (append ,sym ,@lists)))
|
||||
|
||||
(defmacro setq! (&rest settings)
|
||||
"A more sensible `setopt' for setting customizable variables.
|
||||
|
||||
This can be used as a drop-in replacement for `setq' and *should* be used
|
||||
instead of `setopt'. Unlike `setq', this triggers custom setters on variables.
|
||||
Unlike `setopt', this won't needlessly pull in dependencies."
|
||||
(macroexp-progn
|
||||
(cl-loop for (var val) on settings by 'cddr
|
||||
collect `(funcall (or (get ',var 'custom-set) #'set)
|
||||
',var ,val))))
|
||||
|
||||
(defmacro delq! (elt list &optional fetcher)
|
||||
"`delq' ELT from LIST in-place.
|
||||
|
||||
If FETCHER is a function, ELT is used as the key in LIST (an alist)."
|
||||
`(setq ,list (delq ,(if fetcher
|
||||
`(funcall ,fetcher ,elt ,list)
|
||||
elt)
|
||||
,list)))
|
||||
|
||||
(defmacro pushnew! (place &rest values)
|
||||
"Push VALUES sequentially into PLACE, if they aren't already present.
|
||||
This is a variadic `cl-pushnew'."
|
||||
(let ((var (make-symbol "result")))
|
||||
`(dolist (,var (list ,@values) (with-no-warnings ,place))
|
||||
(cl-pushnew ,var ,place :test #'equal))))
|
||||
|
||||
(defmacro prependq! (sym &rest lists)
|
||||
"Prepend LISTS to SYM in place."
|
||||
`(setq ,sym (append ,@lists ,sym)))
|
||||
|
||||
|
||||
;;; Loading
|
||||
(defmacro add-load-path! (&rest dirs)
|
||||
"Add DIRS to `load-path', relative to the current file.
|
||||
The current file is the file from which `add-to-load-path!' is used."
|
||||
`(let ((default-directory ,(dir!))
|
||||
file-name-handler-alist)
|
||||
(dolist (dir (list ,@dirs))
|
||||
(cl-pushnew (expand-file-name dir) load-path :test #'string=))))
|
||||
|
||||
(defmacro after! (package &rest body)
|
||||
"Evaluate BODY after PACKAGE have loaded.
|
||||
|
||||
PACKAGE is a symbol or list of them. These are package names, not modes,
|
||||
functions or variables. It can be:
|
||||
|
||||
- An unquoted package symbol (the name of a package)
|
||||
(after! helm BODY...)
|
||||
- An unquoted list of package symbols (i.e. BODY is evaluated once both magit
|
||||
and git-gutter have loaded)
|
||||
(after! (magit git-gutter) BODY...)
|
||||
- An unquoted, nested list of compound package lists, using any combination of
|
||||
:or/:any and :and/:all
|
||||
(after! (:or package-a package-b ...) BODY...)
|
||||
(after! (:and package-a package-b ...) BODY...)
|
||||
(after! (:and package-a (:or package-b package-c) ...) BODY...)
|
||||
Without :or/:any/:and/:all, :and/:all are implied.
|
||||
|
||||
This is a wrapper around `eval-after-load' that:
|
||||
|
||||
1. Suppresses warnings for disabled packages at compile-time
|
||||
2. No-ops for package that are disabled by the user (via `package!')
|
||||
3. Supports compound package statements (see below)
|
||||
4. Prevents eager expansion pulling in autoloaded macros all at once"
|
||||
(declare (indent defun) (debug t))
|
||||
(if (symbolp package)
|
||||
(unless (memq package (bound-and-true-p doom-disabled-packages))
|
||||
(list (if (or (not (bound-and-true-p byte-compile-current-file))
|
||||
(require package nil 'noerror))
|
||||
#'progn
|
||||
#'with-no-warnings)
|
||||
;; We intentionally avoid `with-eval-after-load' to prevent eager
|
||||
;; macro expansion from pulling (or failing to pull) in autoloaded
|
||||
;; macros/packages.
|
||||
`(eval-after-load ',package ',(macroexp-progn body))))
|
||||
(let ((p (car package)))
|
||||
(cond ((memq p '(:or :any))
|
||||
(macroexp-progn
|
||||
(cl-loop for next in (cdr package)
|
||||
collect `(after! ,next ,@body))))
|
||||
((memq p '(:and :all))
|
||||
(dolist (next (reverse (cdr package)) (car body))
|
||||
(setq body `((after! ,next ,@body)))))
|
||||
(`(after! (:and ,@package) ,@body))))))
|
||||
|
||||
(defun doom--handle-load-error (e target path)
|
||||
(let* ((source (file-name-sans-extension target))
|
||||
(err (cond ((not (featurep 'doom))
|
||||
(cons 'error (file-name-directory path)))
|
||||
((file-in-directory-p source doom-core-dir)
|
||||
(cons 'doom-error doom-core-dir))
|
||||
((file-in-directory-p source doom-private-dir)
|
||||
(cons 'doom-private-error doom-private-dir))
|
||||
((file-in-directory-p source (expand-file-name "cli" doom-core-dir))
|
||||
(cons 'doom-cli-error (expand-file-name "cli" doom-core-dir)))
|
||||
((cons 'doom-module-error doom-emacs-dir)))))
|
||||
(signal (car err)
|
||||
(list (file-relative-name
|
||||
(concat source ".el")
|
||||
(cdr err))
|
||||
e))))
|
||||
|
||||
(defmacro load! (filename &optional path noerror)
|
||||
"Load a file relative to the current executing file (`load-file-name').
|
||||
|
||||
FILENAME is either a file path string or a form that should evaluate to such a
|
||||
string at run time. PATH is where to look for the file (a string representing a
|
||||
directory path). If omitted, the lookup is relative to either `load-file-name',
|
||||
`byte-compile-current-file' or `buffer-file-name' (checked in that order).
|
||||
|
||||
If NOERROR is non-nil, don't throw an error if the file doesn't exist."
|
||||
(let* ((path (or path
|
||||
(dir!)
|
||||
(error "Could not detect path to look for '%s' in"
|
||||
filename)))
|
||||
(file (if path
|
||||
`(expand-file-name ,filename ,path)
|
||||
filename)))
|
||||
`(condition-case-unless-debug e
|
||||
(let (file-name-handler-alist)
|
||||
(load ,file ,noerror 'nomessage))
|
||||
(doom-error (signal (car e) (cdr e)))
|
||||
(error (doom--handle-load-error e ,file ,path)))))
|
||||
|
||||
(defmacro defer-until! (condition &rest body)
|
||||
"Run BODY when CONDITION is true (checks on `after-load-functions'). Meant to
|
||||
serve as a predicated alternative to `after!'."
|
||||
(declare (indent defun) (debug t))
|
||||
`(if ,condition
|
||||
(progn ,@body)
|
||||
,(let ((fn (intern (format "doom--delay-form-%s-h" (sxhash (cons condition body))))))
|
||||
`(progn
|
||||
(fset ',fn (lambda (&rest args)
|
||||
(when ,(or condition t)
|
||||
(remove-hook 'after-load-functions #',fn)
|
||||
(unintern ',fn nil)
|
||||
(ignore args)
|
||||
,@body)))
|
||||
(put ',fn 'permanent-local-hook t)
|
||||
(add-hook 'after-load-functions #',fn)))))
|
||||
|
||||
(defmacro defer-feature! (feature &rest fns)
|
||||
"Pretend FEATURE hasn't been loaded yet, until FEATURE-hook or FN runs.
|
||||
|
||||
Some packages (like `elisp-mode' and `lisp-mode') are loaded immediately at
|
||||
startup, which will prematurely trigger `after!' (and `with-eval-after-load')
|
||||
blocks. To get around this we make Emacs believe FEATURE hasn't been loaded yet,
|
||||
then wait until FEATURE-hook (or MODE-hook, if FN is provided) is triggered to
|
||||
reverse this and trigger `after!' blocks at a more reasonable time."
|
||||
(let ((advice-fn (intern (format "doom--defer-feature-%s-a" feature))))
|
||||
`(progn
|
||||
(delq! ',feature features)
|
||||
(defadvice! ,advice-fn (&rest _)
|
||||
:before ',fns
|
||||
;; Some plugins (like yasnippet) will invoke a fn early to parse
|
||||
;; code, which would prematurely trigger this. In those cases, well
|
||||
;; behaved plugins will use `delay-mode-hooks', which we can check for:
|
||||
(unless delay-mode-hooks
|
||||
;; ...Otherwise, announce to the world this package has been loaded,
|
||||
;; so `after!' handlers can react.
|
||||
(provide ',feature)
|
||||
(dolist (fn ',fns)
|
||||
(advice-remove fn #',advice-fn)))))))
|
||||
|
||||
|
||||
;;; Hooks
|
||||
(defmacro add-transient-hook! (hook-or-function &rest forms)
|
||||
"Attaches a self-removing function to HOOK-OR-FUNCTION.
|
||||
|
||||
FORMS are evaluated once, when that function/hook is first invoked, then never
|
||||
again.
|
||||
|
||||
HOOK-OR-FUNCTION can be a quoted hook or a sharp-quoted function (which will be
|
||||
advised)."
|
||||
(declare (indent 1))
|
||||
(let ((append (if (eq (car forms) :after) (pop forms)))
|
||||
;; Avoid `make-symbol' and `gensym' here because an interned symbol is
|
||||
;; easier to debug in backtraces (and is visible to `describe-function')
|
||||
(fn (intern (format "doom--transient-%d-h"
|
||||
(put 'add-transient-hook! 'counter
|
||||
(1+ (or (get 'add-transient-hook! 'counter)
|
||||
0)))))))
|
||||
`(let ((sym ,hook-or-function))
|
||||
(defun ,fn (&rest _)
|
||||
,(format "Transient hook for %S" (doom-unquote hook-or-function))
|
||||
,@forms
|
||||
(let ((sym ,hook-or-function))
|
||||
(cond ((functionp sym) (advice-remove sym #',fn))
|
||||
((symbolp sym) (remove-hook sym #',fn))))
|
||||
(unintern ',fn nil))
|
||||
(cond ((functionp sym)
|
||||
(advice-add ,hook-or-function ,(if append :after :before) #',fn))
|
||||
((symbolp sym)
|
||||
(put ',fn 'permanent-local-hook t)
|
||||
(add-hook sym #',fn ,append))))))
|
||||
|
||||
(defmacro add-hook! (hooks &rest rest)
|
||||
"A convenience macro for adding N functions to M hooks.
|
||||
|
||||
This macro accepts, in order:
|
||||
|
||||
1. The mode(s) or hook(s) to add to. This is either an unquoted mode, an
|
||||
unquoted list of modes, a quoted hook variable or a quoted list of hook
|
||||
variables.
|
||||
2. Optional properties :local, :append, and/or :depth [N], which will make the
|
||||
hook buffer-local or append to the list of hooks (respectively),
|
||||
3. The function(s) to be added: this can be a quoted function, a quoted list
|
||||
thereof, a list of `defun' or `cl-defun' forms, or arbitrary forms (will
|
||||
implicitly be wrapped in a lambda).
|
||||
|
||||
\(fn HOOKS [:append :local [:depth N]] FUNCTIONS-OR-FORMS...)"
|
||||
(declare (indent (lambda (indent-point state)
|
||||
(goto-char indent-point)
|
||||
(when (looking-at-p "\\s-*(")
|
||||
(lisp-indent-defform state indent-point))))
|
||||
(debug t))
|
||||
(let* ((hook-forms (doom--resolve-hook-forms hooks))
|
||||
(func-forms ())
|
||||
(defn-forms ())
|
||||
append-p local-p remove-p depth)
|
||||
(while (keywordp (car rest))
|
||||
(pcase (pop rest)
|
||||
(:append (setq append-p t))
|
||||
(:depth (setq depth (pop rest)))
|
||||
(:local (setq local-p t))
|
||||
(:remove (setq remove-p t))))
|
||||
(while rest
|
||||
(let* ((next (pop rest))
|
||||
(first (car-safe next)))
|
||||
(push (cond ((memq first '(function nil))
|
||||
next)
|
||||
((eq first 'quote)
|
||||
(let ((quoted (cadr next)))
|
||||
(if (atom quoted)
|
||||
next
|
||||
(when (cdr quoted)
|
||||
(setq rest (cons (list first (cdr quoted)) rest)))
|
||||
(list first (car quoted)))))
|
||||
((memq first '(defun cl-defun))
|
||||
(push next defn-forms)
|
||||
(list 'function (cadr next)))
|
||||
((prog1 `(lambda (&rest _) ,@(cons next rest))
|
||||
(setq rest nil))))
|
||||
func-forms)))
|
||||
`(progn
|
||||
,@defn-forms
|
||||
(dolist (hook (nreverse ',hook-forms))
|
||||
(dolist (func (list ,@func-forms))
|
||||
,(if remove-p
|
||||
`(remove-hook hook func ,local-p)
|
||||
`(add-hook hook func ,(or depth append-p) ,local-p)))))))
|
||||
|
||||
(defmacro remove-hook! (hooks &rest rest)
|
||||
"A convenience macro for removing N functions from M hooks.
|
||||
|
||||
Takes the same arguments as `add-hook!'.
|
||||
|
||||
If N and M = 1, there's no benefit to using this macro over `remove-hook'.
|
||||
|
||||
\(fn HOOKS [:append :local] FUNCTIONS)"
|
||||
(declare (indent defun) (debug t))
|
||||
`(add-hook! ,hooks :remove ,@rest))
|
||||
|
||||
(defmacro setq-hook! (hooks &rest var-vals)
|
||||
"Sets buffer-local variables on HOOKS.
|
||||
|
||||
\(fn HOOKS &rest [SYM VAL]...)"
|
||||
(declare (indent 1))
|
||||
(macroexp-progn
|
||||
(cl-loop for (var val hook fn) in (doom--setq-hook-fns hooks var-vals)
|
||||
collect `(defun ,fn (&rest _)
|
||||
,(format "%s = %s" var (pp-to-string val))
|
||||
(setq-local ,var ,val))
|
||||
collect `(remove-hook ',hook #',fn) ; ensure set order
|
||||
collect `(add-hook ',hook #',fn))))
|
||||
|
||||
(defmacro unsetq-hook! (hooks &rest vars)
|
||||
"Unbind setq hooks on HOOKS for VARS.
|
||||
|
||||
\(fn HOOKS &rest [SYM VAL]...)"
|
||||
(declare (indent 1))
|
||||
(macroexp-progn
|
||||
(cl-loop for (_var _val hook fn)
|
||||
in (doom--setq-hook-fns hooks vars 'singles)
|
||||
collect `(remove-hook ',hook #',fn))))
|
||||
|
||||
|
||||
;;; Definers
|
||||
(defmacro defadvice! (symbol arglist &optional docstring &rest body)
|
||||
"Define an advice called SYMBOL and add it to PLACES.
|
||||
|
||||
ARGLIST is as in `defun'. WHERE is a keyword as passed to `advice-add', and
|
||||
PLACE is the function to which to add the advice, like in `advice-add'.
|
||||
DOCSTRING and BODY are as in `defun'.
|
||||
|
||||
\(fn SYMBOL ARGLIST &optional DOCSTRING &rest [WHERE PLACES...] BODY\)"
|
||||
(declare (doc-string 3) (indent defun))
|
||||
(unless (stringp docstring)
|
||||
(push docstring body)
|
||||
(setq docstring nil))
|
||||
(let (where-alist)
|
||||
(while (keywordp (car body))
|
||||
(push `(cons ,(pop body) (doom-enlist ,(pop body)))
|
||||
where-alist))
|
||||
`(progn
|
||||
(defun ,symbol ,arglist ,docstring ,@body)
|
||||
(dolist (targets (list ,@(nreverse where-alist)))
|
||||
(dolist (target (cdr targets))
|
||||
(advice-add target (car targets) #',symbol))))))
|
||||
|
||||
(defmacro undefadvice! (symbol _arglist &optional docstring &rest body)
|
||||
"Undefine an advice called SYMBOL.
|
||||
|
||||
This has the same signature as `defadvice!' an exists as an easy undefiner when
|
||||
testing advice (when combined with `rotate-text').
|
||||
|
||||
\(fn SYMBOL ARGLIST &optional DOCSTRING &rest [WHERE PLACES...] BODY\)"
|
||||
(declare (doc-string 3) (indent defun))
|
||||
(let (where-alist)
|
||||
(unless (stringp docstring)
|
||||
(push docstring body))
|
||||
(while (keywordp (car body))
|
||||
(push `(cons ,(pop body) (doom-enlist ,(pop body)))
|
||||
where-alist))
|
||||
`(dolist (targets (list ,@(nreverse where-alist)))
|
||||
(dolist (target (cdr targets))
|
||||
(advice-remove target #',symbol)))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Backports
|
||||
|
||||
;; `format-spec' wasn't autoloaded until 28.1
|
||||
(unless (fboundp 'format-spec)
|
||||
(autoload #'format-spec "format-spec"))
|
||||
|
||||
;; Introduced in Emacs 28.1
|
||||
(unless (fboundp 'ensure-list)
|
||||
(defun ensure-list (object)
|
||||
"Return OBJECT as a list.
|
||||
If OBJECT is already a list, return OBJECT itself. If it's
|
||||
not a list, return a one-element list containing OBJECT."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(if (listp object)
|
||||
object
|
||||
(list object))))
|
||||
|
||||
;; Introduced in Emacs 28.1
|
||||
(unless (fboundp 'always)
|
||||
(defun always (&rest _arguments)
|
||||
"Do nothing and return t.
|
||||
This function accepts any number of ARGUMENTS, but ignores them.
|
||||
Also see `ignore'."
|
||||
t))
|
||||
|
||||
(provide 'doom-lib)
|
||||
;;; doom-lib.el ends here
|
||||
576
lisp/doom-modules.el
Normal file
576
lisp/doom-modules.el
Normal file
|
|
@ -0,0 +1,576 @@
|
|||
;;; doom-modules.el --- module & package management system -*- lexical-binding: t; -*-
|
||||
|
||||
(defvar doom-init-modules-p nil
|
||||
"Non-nil if `doom-initialize-modules' has run.")
|
||||
|
||||
(defvar doom-modules (make-hash-table :test 'equal)
|
||||
"A hash table of enabled modules. Set by `doom-initialize-modules'.")
|
||||
|
||||
(defvar doom-modules-dirs
|
||||
(list (expand-file-name "modules/" doom-private-dir)
|
||||
doom-modules-dir)
|
||||
"A list of module root directories. Order determines priority.")
|
||||
|
||||
(defvar doom-module-init-file "init"
|
||||
"The basename of init files for modules.
|
||||
|
||||
Init files are loaded early, just after Doom core, and before modules' config
|
||||
files. They are always loaded, even in non-interactive sessions, and before
|
||||
`doom-before-init-modules-hook'. Related to `doom-module-config-file'.")
|
||||
|
||||
(defvar doom-module-config-file "config"
|
||||
"The basename of config files for modules.
|
||||
|
||||
Config files are loaded later, and almost always in interactive sessions. These
|
||||
run before `doom-init-modules-hook'. Relevant to `doom-module-init-file'.")
|
||||
|
||||
(defconst doom-obsolete-modules
|
||||
'((:feature (version-control (:emacs vc) (:ui vc-gutter))
|
||||
(spellcheck (:checkers spell))
|
||||
(syntax-checker (:checkers syntax))
|
||||
(evil (:editor evil))
|
||||
(snippets (:editor snippets))
|
||||
(file-templates (:editor file-templates))
|
||||
(workspaces (:ui workspaces))
|
||||
(eval (:tools eval))
|
||||
(lookup (:tools lookup))
|
||||
(debugger (:tools debugger)))
|
||||
(:tools (rotate-text (:editor rotate-text))
|
||||
(vterm (:term vterm))
|
||||
(password-store (:tools pass))
|
||||
(flycheck (:checkers syntax))
|
||||
(flyspell (:checkers spell))
|
||||
(macos (:os macos)))
|
||||
(:emacs (electric-indent (:emacs electric))
|
||||
(hideshow (:editor fold))
|
||||
(eshell (:term eshell))
|
||||
(term (:term term)))
|
||||
(:ui (doom-modeline (:ui modeline))
|
||||
(fci (:ui fill-column))
|
||||
(evil-goggles (:ui ophints))
|
||||
(tabbar (:ui tabs))
|
||||
(pretty-code (:ui ligatures)))
|
||||
(:app (email (:email mu4e))
|
||||
(notmuch (:email notmuch)))
|
||||
(:lang (perl (:lang raku))))
|
||||
"A tree alist that maps deprecated modules to their replacement(s).
|
||||
|
||||
Each entry is a three-level tree. For example:
|
||||
|
||||
(:feature (version-control (:emacs vc) (:ui vc-gutter))
|
||||
(spellcheck (:checkers spell))
|
||||
(syntax-checker (:tools flycheck)))
|
||||
|
||||
This marks :feature version-control, :feature spellcheck and :feature
|
||||
syntax-checker modules obsolete. e.g. If :feature version-control is found in
|
||||
your `doom!' block, a warning is emitted before replacing it with :emacs vc and
|
||||
:ui vc-gutter.")
|
||||
|
||||
(defvar doom-inhibit-module-warnings (not noninteractive)
|
||||
"If non-nil, don't emit deprecated or missing module warnings at startup.")
|
||||
|
||||
;;; Custom hooks
|
||||
(defvar doom-before-init-modules-hook nil
|
||||
"A list of hooks to run before Doom's modules' config.el files are loaded, but
|
||||
after their init.el files are loaded.")
|
||||
|
||||
(defvar doom-init-modules-hook nil
|
||||
"A list of hooks to run after Doom's modules' config.el files have loaded, but
|
||||
before the user's private module.")
|
||||
|
||||
(defvaralias 'doom-after-init-modules-hook 'after-init-hook)
|
||||
|
||||
(defvar doom--current-module nil)
|
||||
(defvar doom--current-flags nil)
|
||||
|
||||
|
||||
;;
|
||||
;;; Bootstrap API
|
||||
|
||||
(defun doom-initialize-core-modules ()
|
||||
"Load Doom's core files for an interactive session."
|
||||
(require 'doom-keybinds)
|
||||
(require 'doom-ui)
|
||||
(require 'doom-projects)
|
||||
(require 'doom-editor))
|
||||
|
||||
(defun doom-module-loader (file)
|
||||
"Return a closure that loads FILE from a module.
|
||||
|
||||
This closure takes two arguments: a cons cell containing (CATEGORY . MODULE)
|
||||
symbols, and that module's plist."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(lambda (module plist)
|
||||
(let ((doom--current-module module)
|
||||
(doom--current-flags (plist-get plist :flags))
|
||||
(inhibit-redisplay t))
|
||||
(load! file (plist-get plist :path) t))))
|
||||
|
||||
(defun doom-initialize-modules (&optional force-p no-config-p)
|
||||
"Loads the init.el in `doom-private-dir' and sets up hooks for a healthy
|
||||
session of Dooming. Will noop if used more than once, unless FORCE-P is
|
||||
non-nil."
|
||||
(when (or force-p (not doom-init-modules-p))
|
||||
(setq doom-init-modules-p t)
|
||||
(unless no-config-p
|
||||
(doom-log "Initializing core modules")
|
||||
(doom-initialize-core-modules))
|
||||
(when-let (init-p (load! doom-module-init-file doom-private-dir t))
|
||||
(doom-log "Initializing user config")
|
||||
(maphash (doom-module-loader doom-module-init-file) doom-modules)
|
||||
(doom-run-hooks 'doom-before-init-modules-hook)
|
||||
(unless no-config-p
|
||||
(maphash (doom-module-loader doom-module-config-file) doom-modules)
|
||||
(doom-run-hooks 'doom-init-modules-hook)
|
||||
(load! "config" doom-private-dir t)
|
||||
(when custom-file
|
||||
(load custom-file 'noerror (not doom-debug-mode)))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Module API
|
||||
|
||||
(defun doom-module-p (category module &optional flag)
|
||||
"Returns t if CATEGORY MODULE is enabled (ie. present in `doom-modules')."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(when-let (plist (gethash (cons category module) doom-modules))
|
||||
(or (null flag)
|
||||
(and (memq flag (plist-get plist :flags))
|
||||
t))))
|
||||
|
||||
(defun doom-module-get (category module &optional property)
|
||||
"Returns the plist for CATEGORY MODULE. Gets PROPERTY, specifically, if set."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(when-let (plist (gethash (cons category module) doom-modules))
|
||||
(if property
|
||||
(plist-get plist property)
|
||||
plist)))
|
||||
|
||||
(defun doom-module-put (category module &rest plist)
|
||||
"Set a PROPERTY for CATEGORY MODULE to VALUE. PLIST should be additional pairs
|
||||
of PROPERTY and VALUEs.
|
||||
|
||||
\(fn CATEGORY MODULE PROPERTY VALUE &rest [PROPERTY VALUE [...]])"
|
||||
(puthash (cons category module)
|
||||
(if-let (old-plist (doom-module-get category module))
|
||||
(if (null plist)
|
||||
old-plist
|
||||
(when (cl-oddp (length plist))
|
||||
(signal 'wrong-number-of-arguments (list (length plist))))
|
||||
(while plist
|
||||
(plist-put old-plist (pop plist) (pop plist)))
|
||||
old-plist)
|
||||
plist)
|
||||
doom-modules))
|
||||
|
||||
(defun doom-module-set (category module &rest plist)
|
||||
"Enables a module by adding it to `doom-modules'.
|
||||
|
||||
CATEGORY is a keyword, module is a symbol, PLIST is a plist that accepts the
|
||||
following properties:
|
||||
|
||||
:flags [SYMBOL LIST] list of enabled category flags
|
||||
:path [STRING] path to category root directory
|
||||
|
||||
Example:
|
||||
(doom-module-set :lang 'haskell :flags '(+lsp))"
|
||||
(puthash (cons category module) plist doom-modules))
|
||||
|
||||
(defun doom-module-path (category module &optional file)
|
||||
"Like `expand-file-name', but expands FILE relative to CATEGORY (keywordp) and
|
||||
MODULE (symbol).
|
||||
|
||||
If the category isn't enabled this will always return nil. For finding disabled
|
||||
modules use `doom-module-locate-path'."
|
||||
(let ((path (doom-module-get category module :path)))
|
||||
(if file
|
||||
(let (file-name-handler-alist)
|
||||
(expand-file-name file path))
|
||||
path)))
|
||||
|
||||
(defun doom-module-locate-path (category &optional module file)
|
||||
"Searches `doom-modules-dirs' to find the path to a module.
|
||||
|
||||
CATEGORY is a keyword (e.g. :lang) and MODULE is a symbol (e.g. 'python). FILE
|
||||
is a string that will be appended to the resulting path. If no path exists, this
|
||||
returns nil, otherwise an absolute path.
|
||||
|
||||
This doesn't require modules to be enabled. For enabled modules us
|
||||
`doom-module-path'."
|
||||
(when (keywordp category)
|
||||
(setq category (doom-keyword-name category)))
|
||||
(when (and module (symbolp module))
|
||||
(setq module (symbol-name module)))
|
||||
(cl-loop with file-name-handler-alist = nil
|
||||
for default-directory in doom-modules-dirs
|
||||
for path = (concat category "/" module "/" file)
|
||||
if (file-exists-p path)
|
||||
return (expand-file-name path)))
|
||||
|
||||
(defun doom-module-from-path (&optional path enabled-only)
|
||||
"Returns a cons cell (CATEGORY . MODULE) derived from PATH (a file path).
|
||||
If ENABLED-ONLY, return nil if the containing module isn't enabled."
|
||||
(if (null path)
|
||||
(if doom--current-module
|
||||
(if enabled-only
|
||||
(and (doom-module-p (car doom--current-module)
|
||||
(cdr doom--current-module))
|
||||
doom--current-module)
|
||||
doom--current-module)
|
||||
(ignore-errors
|
||||
(doom-module-from-path (file!))))
|
||||
(let* ((file-name-handler-alist nil)
|
||||
(path (expand-file-name (or path (file!)))))
|
||||
(save-match-data
|
||||
(cond ((string-match "/modules/\\([^/]+\\)/\\([^/]+\\)\\(?:/.*\\)?$" path)
|
||||
(when-let* ((category (doom-keyword-intern (match-string 1 path)))
|
||||
(module (intern (match-string 2 path))))
|
||||
(and (or (null enabled-only)
|
||||
(doom-module-p category module))
|
||||
(cons category module))))
|
||||
((or (string-match-p (concat "^" (regexp-quote doom-core-dir)) path)
|
||||
(file-in-directory-p path doom-core-dir))
|
||||
(cons :core (intern (file-name-base path))))
|
||||
((or (string-match-p (concat "^" (regexp-quote doom-private-dir)) path)
|
||||
(file-in-directory-p path doom-private-dir))
|
||||
(cons :private (intern (file-name-base path)))))))))
|
||||
|
||||
(defun doom-module-load-path (&optional module-dirs)
|
||||
"Return a list of file paths to activated modules.
|
||||
|
||||
The list is in no particular order and its file paths are absolute. If
|
||||
MODULE-DIRS is non-nil, include all modules (even disabled ones) available in
|
||||
those directories. The first returned path is always `doom-private-dir'."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(append (list doom-private-dir)
|
||||
(if module-dirs
|
||||
(mapcar (lambda (m) (doom-module-locate-path (car m) (cdr m)))
|
||||
(delete-dups
|
||||
(doom-files-in (if (listp module-dirs)
|
||||
module-dirs
|
||||
doom-modules-dirs)
|
||||
:map #'doom-module-from-path
|
||||
:type 'dirs
|
||||
:mindepth 1
|
||||
:depth 1)))
|
||||
(delq
|
||||
nil (cl-loop for plist being the hash-values of doom-modules
|
||||
collect (plist-get plist :path)) ))
|
||||
nil))
|
||||
|
||||
(defun doom-module-mplist-map (fn mplist)
|
||||
"Apply FN to each module in MPLIST."
|
||||
(let ((mplist (copy-sequence mplist))
|
||||
(inhibit-message doom-inhibit-module-warnings)
|
||||
obsolete
|
||||
results
|
||||
category m)
|
||||
(while mplist
|
||||
(setq m (pop mplist))
|
||||
(cond ((keywordp m)
|
||||
(setq category m
|
||||
obsolete (assq m doom-obsolete-modules)))
|
||||
((null category)
|
||||
(error "No module category specified for %s" m))
|
||||
((and (listp m) (keywordp (car m)))
|
||||
(pcase (car m)
|
||||
(:cond
|
||||
(cl-loop for (cond . mods) in (cdr m)
|
||||
if (eval cond t)
|
||||
return (prependq! mplist mods)))
|
||||
(:if (if (eval (cadr m) t)
|
||||
(push (caddr m) mplist)
|
||||
(prependq! mplist (cdddr m))))
|
||||
(test (if (xor (eval (cadr m) t)
|
||||
(eq test :unless))
|
||||
(prependq! mplist (cddr m))))))
|
||||
((catch 'doom-modules
|
||||
(let* ((module (if (listp m) (car m) m))
|
||||
(flags (if (listp m) (cdr m))))
|
||||
(when-let (new (assq module obsolete))
|
||||
(let ((newkeys (cdr new)))
|
||||
(if (null newkeys)
|
||||
(message "WARNING %s module was removed" (list category module))
|
||||
(if (cdr newkeys)
|
||||
(message "WARNING %s module was removed and split into the %s modules"
|
||||
(list category module) (mapconcat #'prin1-to-string newkeys ", "))
|
||||
(message "WARNING %s module was moved to %s"
|
||||
(list category module) (car newkeys)))
|
||||
(push category mplist)
|
||||
(dolist (key newkeys)
|
||||
(push (if flags
|
||||
(nconc (cdr key) flags)
|
||||
(cdr key))
|
||||
mplist)
|
||||
(push (car key) mplist))
|
||||
(throw 'doom-modules t))))
|
||||
(let ((path (doom-module-locate-path category module)))
|
||||
(push (funcall fn category module
|
||||
:flags (if (listp m) (cdr m))
|
||||
:path (if (stringp path) (file-truename path)))
|
||||
results)))))))
|
||||
(when noninteractive
|
||||
(setq doom-inhibit-module-warnings t))
|
||||
(nreverse results)))
|
||||
|
||||
(defun doom-module-list (&optional all-p)
|
||||
"Minimally initialize `doom-modules' (a hash table) and return it.
|
||||
This value is cached. If REFRESH-P, then don't use the cached value."
|
||||
(if all-p
|
||||
(mapcar #'doom-module-from-path (cdr (doom-module-load-path 'all)))
|
||||
doom-modules))
|
||||
|
||||
|
||||
;;
|
||||
;;; Use-package modifications
|
||||
|
||||
(defvar doom--deferred-packages-alist '(t))
|
||||
|
||||
(autoload 'use-package "use-package-core" nil nil t)
|
||||
|
||||
(setq use-package-compute-statistics init-file-debug
|
||||
use-package-verbose init-file-debug
|
||||
use-package-minimum-reported-time (if init-file-debug 0 0.1)
|
||||
use-package-expand-minimally (not noninteractive))
|
||||
|
||||
;; A common mistake for new users is that they inadvertently install their
|
||||
;; packages with package.el, by copying over old `use-package' declarations with
|
||||
;; an :ensure t property. Doom doesn't use package.el, so this will throw an
|
||||
;; error that will confuse beginners, so we disable `:ensure'.
|
||||
(setq use-package-ensure-function
|
||||
(lambda (name &rest _)
|
||||
(message "Ignoring ':ensure t' in '%s' config" name)))
|
||||
;; ...On the other hand, if the user has loaded `package', then we should assume
|
||||
;; they know what they're doing and restore the old behavior:
|
||||
(add-transient-hook! 'package-initialize
|
||||
(when (eq use-package-ensure-function #'ignore)
|
||||
(setq use-package-ensure-function #'use-package-ensure-elpa)))
|
||||
|
||||
(with-eval-after-load 'use-package-core
|
||||
;; `use-package' adds syntax highlighting for the `use-package' macro, but
|
||||
;; Emacs 26+ already highlights macros, so it's redundant.
|
||||
(font-lock-remove-keywords 'emacs-lisp-mode use-package-font-lock-keywords)
|
||||
|
||||
;; We define :minor and :magic-minor from the `auto-minor-mode' package here
|
||||
;; so we don't have to load `auto-minor-mode' so early.
|
||||
(dolist (keyword '(:minor :magic-minor))
|
||||
(setq use-package-keywords
|
||||
(use-package-list-insert keyword use-package-keywords :commands)))
|
||||
|
||||
(defalias 'use-package-normalize/:minor #'use-package-normalize-mode)
|
||||
(defun use-package-handler/:minor (name _ arg rest state)
|
||||
(use-package-handle-mode name 'auto-minor-mode-alist arg rest state))
|
||||
|
||||
(defalias 'use-package-normalize/:magic-minor #'use-package-normalize-mode)
|
||||
(defun use-package-handler/:magic-minor (name _ arg rest state)
|
||||
(use-package-handle-mode name 'auto-minor-mode-magic-alist arg rest state))
|
||||
|
||||
;; HACK Fix `:load-path' so it resolves relative paths to the containing file,
|
||||
;; rather than `user-emacs-directory'. This is a done as a convenience
|
||||
;; for users, wanting to specify a local directory.
|
||||
(defadvice! doom--resolve-load-path-from-containg-file-a (fn label arg &optional recursed)
|
||||
"Resolve :load-path from the current directory."
|
||||
:around #'use-package-normalize-paths
|
||||
;; `use-package-normalize-paths' resolves paths relative to
|
||||
;; `user-emacs-directory', so we change that.
|
||||
(let ((user-emacs-directory
|
||||
(or (and (stringp arg)
|
||||
(not (file-name-absolute-p arg))
|
||||
(ignore-errors (dir!)))
|
||||
doom-emacs-dir)))
|
||||
(funcall fn label arg recursed)))
|
||||
|
||||
;; Adds two keywords to `use-package' to expand its lazy-loading capabilities:
|
||||
;;
|
||||
;; :after-call SYMBOL|LIST
|
||||
;; :defer-incrementally SYMBOL|LIST|t
|
||||
;;
|
||||
;; Check out `use-package!'s documentation for more about these two.
|
||||
(dolist (keyword '(:defer-incrementally :after-call))
|
||||
(push keyword use-package-deferring-keywords)
|
||||
(setq use-package-keywords
|
||||
(use-package-list-insert keyword use-package-keywords :after)))
|
||||
|
||||
(defalias 'use-package-normalize/:defer-incrementally #'use-package-normalize-symlist)
|
||||
(defun use-package-handler/:defer-incrementally (name _keyword targets rest state)
|
||||
(use-package-concat
|
||||
`((doom-load-packages-incrementally
|
||||
',(if (equal targets '(t))
|
||||
(list name)
|
||||
(append targets (list name)))))
|
||||
(use-package-process-keywords name rest state)))
|
||||
|
||||
(defalias 'use-package-normalize/:after-call #'use-package-normalize-symlist)
|
||||
(defun use-package-handler/:after-call (name _keyword hooks rest state)
|
||||
(if (plist-get state :demand)
|
||||
(use-package-process-keywords name rest state)
|
||||
(let ((fn (make-symbol (format "doom--after-call-%s-h" name))))
|
||||
(use-package-concat
|
||||
`((fset ',fn
|
||||
(lambda (&rest _)
|
||||
(doom-log "Loading deferred package %s from %s" ',name ',fn)
|
||||
(condition-case e
|
||||
;; If `default-directory' is a directory that doesn't
|
||||
;; exist or is unreadable, Emacs throws up file-missing
|
||||
;; errors, so we set it to a directory we know exists and
|
||||
;; is readable.
|
||||
(let ((default-directory doom-emacs-dir))
|
||||
(require ',name))
|
||||
((debug error)
|
||||
(message "Failed to load deferred package %s: %s" ',name e)))
|
||||
(when-let (deferral-list (assq ',name doom--deferred-packages-alist))
|
||||
(dolist (hook (cdr deferral-list))
|
||||
(advice-remove hook #',fn)
|
||||
(remove-hook hook #',fn))
|
||||
(delq! deferral-list doom--deferred-packages-alist)
|
||||
(unintern ',fn nil)))))
|
||||
(let (forms)
|
||||
(dolist (hook hooks forms)
|
||||
(push (if (string-match-p "-\\(?:functions\\|hook\\)$" (symbol-name hook))
|
||||
`(add-hook ',hook #',fn)
|
||||
`(advice-add #',hook :before #',fn))
|
||||
forms)))
|
||||
`((unless (assq ',name doom--deferred-packages-alist)
|
||||
(push '(,name) doom--deferred-packages-alist))
|
||||
(nconc (assq ',name doom--deferred-packages-alist)
|
||||
'(,@hooks)))
|
||||
(use-package-process-keywords name rest state))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Module config macros
|
||||
|
||||
(put :if 'lisp-indent-function 2)
|
||||
(put :when 'lisp-indent-function 'defun)
|
||||
(put :unless 'lisp-indent-function 'defun)
|
||||
|
||||
(defmacro doom! (&rest modules)
|
||||
"Bootstraps DOOM Emacs and its modules.
|
||||
|
||||
If the first item in MODULES doesn't satisfy `keywordp', MODULES is evaluated,
|
||||
otherwise, MODULES is a multiple-property list (a plist where each key can have
|
||||
multiple, linear values).
|
||||
|
||||
The bootstrap process involves making sure the essential directories exist, core
|
||||
packages are installed, `doom-autoloads-file' is loaded, `doom-packages-file'
|
||||
cache exists (and is loaded) and, finally, loads your private init.el (which
|
||||
should contain your `doom!' block).
|
||||
|
||||
The overall load order of Doom is as follows:
|
||||
|
||||
~/.emacs.d/init.el
|
||||
~/.emacs.d/lisp/doom.el
|
||||
$DOOMDIR/init.el
|
||||
{$DOOMDIR,~/.emacs.d}/modules/*/*/init.el
|
||||
`doom-before-init-modules-hook'
|
||||
{$DOOMDIR,~/.emacs.d}/modules/*/*/config.el
|
||||
`doom-init-modules-hook'
|
||||
$DOOMDIR/config.el
|
||||
`doom-after-init-modules-hook'
|
||||
`after-init-hook'
|
||||
`emacs-startup-hook'
|
||||
`window-setup-hook'
|
||||
|
||||
Module load order is determined by your `doom!' block. See `doom-modules-dirs'
|
||||
for a list of all recognized module trees. Order defines precedence (from most
|
||||
to least)."
|
||||
`(when noninteractive
|
||||
(doom-module-mplist-map
|
||||
(lambda (category module &rest plist)
|
||||
(if (plist-member plist :path)
|
||||
(apply #'doom-module-set category module plist)
|
||||
(message "WARNING Couldn't find the %s %s module" category module)))
|
||||
,@(if (keywordp (car modules))
|
||||
(list (list 'quote modules))
|
||||
modules))
|
||||
doom-modules))
|
||||
|
||||
(defvar doom-disabled-packages)
|
||||
(defmacro use-package! (name &rest plist)
|
||||
"Declares and configures a package.
|
||||
|
||||
This is a thin wrapper around `use-package', and is ignored if the NAME package
|
||||
is disabled by the user (with `package!').
|
||||
|
||||
See `use-package' to see what properties can be provided. Doom adds support for
|
||||
two extra properties:
|
||||
|
||||
:after-call SYMBOL|LIST
|
||||
Takes a symbol or list of symbols representing functions or hook variables.
|
||||
The first time any of these functions or hooks are executed, the package is
|
||||
loaded.
|
||||
|
||||
:defer-incrementally SYMBOL|LIST|t
|
||||
Takes a symbol or list of symbols representing packages that will be loaded
|
||||
incrementally at startup before this one. This is helpful for large packages
|
||||
like magit or org, which load a lot of dependencies on first load. This lets
|
||||
you load them piece-meal during idle periods, so that when you finally do need
|
||||
the package, it'll load quicker.
|
||||
|
||||
NAME is implicitly added if this property is present and non-nil. No need to
|
||||
specify it. A value of `t' implies NAME."
|
||||
(declare (indent 1))
|
||||
(unless (or (memq name doom-disabled-packages)
|
||||
;; At compile-time, use-package will forcibly load packages to
|
||||
;; prevent compile-time errors. However, if a Doom user has
|
||||
;; disabled packages you get file-missing package errors, so it's
|
||||
;; necessary to check for packages at compile time:
|
||||
(and (bound-and-true-p byte-compile-current-file)
|
||||
(not (locate-library (symbol-name name)))))
|
||||
`(use-package ,name ,@plist)))
|
||||
|
||||
(defmacro use-package-hook! (package when &rest body)
|
||||
"Reconfigures a package's `use-package!' block.
|
||||
|
||||
This macro must be used *before* PACKAGE's `use-package!' block. Often, this
|
||||
means using it from your DOOMDIR/init.el.
|
||||
|
||||
Under the hood, this uses use-package's `use-package-inject-hooks'.
|
||||
|
||||
PACKAGE is a symbol; the package's name.
|
||||
WHEN should be one of the following:
|
||||
:pre-init :post-init :pre-config :post-config
|
||||
|
||||
WARNINGS:
|
||||
- The use of this macro is more often than not a code smell. Use it as last
|
||||
resort. There is almost always a better alternative.
|
||||
- If you are using this solely for :post-config, stop! `after!' is much better.
|
||||
- If :pre-init or :pre-config hooks return nil, the original `use-package!''s
|
||||
:init/:config block (respectively) is overwritten, so remember to have them
|
||||
return non-nil (or exploit that to overwrite Doom's config)."
|
||||
(declare (indent defun))
|
||||
(unless (memq when '(:pre-init :post-init :pre-config :post-config))
|
||||
(error "'%s' isn't a valid hook for use-package-hook!" when))
|
||||
`(progn
|
||||
(setq use-package-inject-hooks t)
|
||||
(add-hook ',(intern (format "use-package--%s--%s-hook"
|
||||
package
|
||||
(substring (symbol-name when) 1)))
|
||||
(lambda () ,@body)
|
||||
'append)))
|
||||
|
||||
(defmacro featurep! (category &optional module flag)
|
||||
"Returns t if CATEGORY MODULE is enabled.
|
||||
|
||||
If FLAG is provided, returns t if CATEGORY MODULE has FLAG enabled.
|
||||
|
||||
(featurep! :config default)
|
||||
|
||||
Module FLAGs are set in your config's `doom!' block, typically in
|
||||
~/.doom.d/init.el. Like so:
|
||||
|
||||
:config (default +flag1 -flag2)
|
||||
|
||||
CATEGORY and MODULE can be omitted When this macro is used from inside a module
|
||||
(except your DOOMDIR, which is a special module). e.g. (featurep! +flag)"
|
||||
(and (cond (flag (memq flag (doom-module-get category module :flags)))
|
||||
(module (doom-module-p category module))
|
||||
(doom--current-flags (memq category doom--current-flags))
|
||||
((if-let (module (doom-module-from-path))
|
||||
(memq category (doom-module-get (car module) (cdr module) :flags))
|
||||
(error "(featurep! %s %s %s) couldn't figure out what module it was called from (in %s)"
|
||||
category module flag (file!)))))
|
||||
t))
|
||||
|
||||
(provide 'doom-modules)
|
||||
;;; doom-modules.el ends here
|
||||
602
lisp/doom-packages.el
Normal file
602
lisp/doom-packages.el
Normal file
|
|
@ -0,0 +1,602 @@
|
|||
;;; lisp/doom-packages.el -*- lexical-binding: t; -*-
|
||||
|
||||
;; Emacs package management is opinionated, and so is Doom. Doom uses `straight'
|
||||
;; to create a declarative, lazy-loaded and (nominally) reproducible package
|
||||
;; management system. We use `straight' over `package' because the latter is
|
||||
;; tempermental. ELPA sources suffer downtime occasionally and often fail to
|
||||
;; build packages when GNU Tar is unavailable (e.g. MacOS users start with BSD
|
||||
;; tar). Known gnutls errors plague the current stable release of Emacs (26.x)
|
||||
;; which bork TLS handshakes with ELPA repos (mainly gnu.elpa.org). See
|
||||
;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=3434.
|
||||
;;
|
||||
;; What's worse, you can only get the latest version of packages through ELPA.
|
||||
;; In an ecosystem that is constantly changing, this is more frustrating than
|
||||
;; convenient. Straight (and Doom) can do rolling release, but it is opt-in.
|
||||
;;
|
||||
;; Interacting with this package management system is done through Doom's
|
||||
;; bin/doom script. Find out more about it by running 'doom help' (I highly
|
||||
;; recommend you add the script to your PATH). Here are some highlights:
|
||||
;;
|
||||
;; + `bin/doom install`: a wizard that guides you through setting up Doom and
|
||||
;; your private config for the first time.
|
||||
;; + `bin/doom sync`: your go-to command for making sure Doom is in optimal
|
||||
;; condition. It ensures all unneeded packages are removed, all needed ones
|
||||
;; are installed, and all metadata associated with them is generated.
|
||||
;; + `bin/doom upgrade`: upgrades Doom Emacs and your packages to the latest
|
||||
;; versions. There's also 'bin/doom sync -u' for updating only your packages.
|
||||
;;
|
||||
;; How this works is: the system reads packages.el files located in each
|
||||
;; activated module, your private directory (`doom-private-dir'), and one in
|
||||
;; `doom-core-dir'. These contain `package!' declarations that tell DOOM what
|
||||
;; plugins to install and where from.
|
||||
;;
|
||||
;; All that said, you can still use package.el's commands, but 'bin/doom sync'
|
||||
;; will purge ELPA packages.
|
||||
|
||||
(defvar doom-packages ()
|
||||
"A list of enabled packages. Each element is a sublist, whose CAR is the
|
||||
package's name as a symbol, and whose CDR is the plist supplied to its
|
||||
`package!' declaration. Set by `doom-initialize-packages'.")
|
||||
|
||||
(defvar doom-disabled-packages ()
|
||||
"A list of packages that should be ignored by `use-package!' and `after!'.")
|
||||
|
||||
(defvar doom-packages-file "packages"
|
||||
"The basename of packages file for modules.
|
||||
|
||||
Package files are read whenever Doom's package manager wants a manifest of all
|
||||
desired packages. They are rarely read in interactive sessions (unless the user
|
||||
uses a straight or package.el command directly).")
|
||||
|
||||
|
||||
;;
|
||||
;;; package.el
|
||||
|
||||
;; Ensure that, if we do need package.el, it is configured correctly. You really
|
||||
;; shouldn't be using it, but it may be convenient for quickly testing packages.
|
||||
(setq package-enable-at-startup nil
|
||||
package-user-dir (concat doom-local-dir "elpa/")
|
||||
package-gnupghome-dir (expand-file-name "gpg" package-user-dir))
|
||||
|
||||
(after! package
|
||||
(let ((s (if gnutls-verify-error "s" "")))
|
||||
(prependq! package-archives
|
||||
;; I omit Marmalade because its packages are manually submitted
|
||||
;; rather than pulled, and so often out of date.
|
||||
`(("melpa" . ,(format "http%s://melpa.org/packages/" s))
|
||||
("org" . ,(format "http%s://orgmode.org/elpa/" s))))))
|
||||
|
||||
;; Refresh package.el the first time you call `package-install', so it can still
|
||||
;; be used (e.g. to temporarily test packages). Remember to run 'doom sync' to
|
||||
;; purge them; they can conflict with packages installed via straight!
|
||||
(add-transient-hook! 'package-install (package-refresh-contents))
|
||||
|
||||
|
||||
;;
|
||||
;;; Straight
|
||||
|
||||
(setq straight-base-dir (file-truename doom-local-dir)
|
||||
straight-repository-branch "develop"
|
||||
;; Since byte-code is rarely compatible across different versions of
|
||||
;; Emacs, it's best we build them in separate directories, per emacs
|
||||
;; version.
|
||||
straight-build-dir (format "build-%s" emacs-version)
|
||||
straight-cache-autoloads nil ; we already do this, and better.
|
||||
;; Doom doesn't encourage you to modify packages in place. Disabling this
|
||||
;; makes 'doom sync' instant (once everything set up), which is much nicer
|
||||
;; UX than the several seconds modification checks.
|
||||
straight-check-for-modifications nil
|
||||
;; We handle package.el ourselves (and a little more comprehensively)
|
||||
straight-enable-package-integration nil
|
||||
;; Before switching to straight, `doom-local-dir' would average out at
|
||||
;; around 100mb with half Doom's modules at ~230 packages. Afterwards, at
|
||||
;; around 1gb. With shallow cloning, that is reduced to ~400mb. This has
|
||||
;; no affect on packages that are pinned, however (run 'doom purge' to
|
||||
;; compact those after-the-fact). Some packages break when shallow cloned
|
||||
;; (like magit and org), but we'll deal with that elsewhere.
|
||||
straight-vc-git-default-clone-depth '(1 single-branch))
|
||||
|
||||
(with-eval-after-load 'straight
|
||||
;; `let-alist' is built into Emacs 26 and onwards
|
||||
(add-to-list 'straight-built-in-pseudo-packages 'let-alist))
|
||||
|
||||
(defadvice! doom--read-pinned-packages-a (fn &rest args)
|
||||
"Read `:pin's in `doom-packages' on top of straight's lockfiles."
|
||||
:around #'straight--lockfile-read-all
|
||||
(append (apply fn args) ; lockfiles still take priority
|
||||
(doom-package-pinned-list)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Bootstrappers
|
||||
|
||||
(defun doom--ensure-straight (recipe pin)
|
||||
(letenv! (("GIT_CONFIG" nil)
|
||||
("GIT_CONFIG_NOSYSTEM" "1")
|
||||
("GIT_CONFIG_GLOBAL" (or (getenv "DOOMGITCONFIG")
|
||||
"/dev/null")))
|
||||
(let ((repo-dir (doom-path straight-base-dir "straight/repos/straight.el"))
|
||||
(repo-url (concat "http" (if gnutls-verify-error "s")
|
||||
"://github.com/"
|
||||
(or (plist-get recipe :repo) "radian-software/straight.el")))
|
||||
(branch (or (plist-get recipe :branch) straight-repository-branch))
|
||||
(call (if init-file-debug
|
||||
(lambda (&rest args)
|
||||
(print! "%s" (cdr (apply #'doom-call-process args))))
|
||||
(lambda (&rest args)
|
||||
(apply #'doom-call-process args)))))
|
||||
(unless (file-directory-p repo-dir)
|
||||
(save-match-data
|
||||
(unless (executable-find "git")
|
||||
(user-error "Git isn't present on your system. Cannot proceed."))
|
||||
(let* ((version (cdr (doom-call-process "git" "version")))
|
||||
(version
|
||||
(and (string-match "\\_<[0-9]+\\.[0-9]+\\(\\.[0-9]+\\)\\_>" version)
|
||||
(match-string 0 version))))
|
||||
(if version
|
||||
(when (version< version "2.23")
|
||||
(user-error "Git %s detected! Doom requires git 2.23 or newer!"
|
||||
version)))))
|
||||
(print! (start "Installing straight..."))
|
||||
(print-group!
|
||||
(cl-destructuring-bind (depth . options)
|
||||
(doom-enlist straight-vc-git-default-clone-depth)
|
||||
(let ((branch-switch (if (memq 'single-branch options)
|
||||
"--single-branch"
|
||||
"--no-single-branch")))
|
||||
(cond
|
||||
((eq 'full depth)
|
||||
(funcall call "git" "clone" "--origin" "origin"
|
||||
branch-switch repo-url repo-dir))
|
||||
((integerp depth)
|
||||
(if (null pin)
|
||||
(progn
|
||||
(when (file-directory-p repo-dir)
|
||||
(delete-directory repo-dir 'recursive))
|
||||
(funcall call "git" "clone" "--origin" "origin" repo-url
|
||||
"--no-checkout" repo-dir
|
||||
"--depth" (number-to-string depth)
|
||||
branch-switch
|
||||
"--no-tags"
|
||||
"--branch" straight-repository-branch))
|
||||
(make-directory repo-dir 'recursive)
|
||||
(let ((default-directory repo-dir))
|
||||
(funcall call "git" "init")
|
||||
(funcall call "git" "branch" "-m" straight-repository-branch)
|
||||
(funcall call "git" "remote" "add" "origin" repo-url
|
||||
"--master" straight-repository-branch)
|
||||
(funcall call "git" "fetch" "origin" pin
|
||||
"--depth" (number-to-string depth)
|
||||
"--no-tags")
|
||||
(funcall call "git" "reset" "--hard" pin)))))))))
|
||||
(require 'straight (concat repo-dir "/straight.el"))
|
||||
(doom-log "Initializing recipes")
|
||||
(mapc #'straight-use-recipes
|
||||
'((org-elpa :local-repo nil)
|
||||
(melpa :type git :host github
|
||||
:repo "melpa/melpa"
|
||||
:build nil)
|
||||
(gnu-elpa-mirror :type git :host github
|
||||
:repo "emacs-straight/gnu-elpa-mirror"
|
||||
:build nil)
|
||||
(el-get :type git :host github
|
||||
:repo "dimitri/el-get"
|
||||
:build nil)
|
||||
(emacsmirror-mirror :type git :host github
|
||||
:repo "emacs-straight/emacsmirror-mirror"
|
||||
:build nil))))))
|
||||
|
||||
(defun doom--ensure-core-packages (packages)
|
||||
(doom-log "Installing core packages")
|
||||
(dolist (package packages)
|
||||
(let* ((name (car package))
|
||||
(repo (symbol-name name)))
|
||||
(when-let (recipe (plist-get (cdr package) :recipe))
|
||||
(straight-override-recipe (cons name recipe))
|
||||
(when-let (local-repo (plist-get recipe :local-repo))
|
||||
(setq repo local-repo)))
|
||||
(print-group!
|
||||
;; Only clone the package, don't build them. Straight hasn't been fully
|
||||
;; configured by this point.
|
||||
(straight-use-package name nil t))
|
||||
;; In case the package hasn't been built yet.
|
||||
(or (member (directory-file-name (straight--build-dir (symbol-name name)))
|
||||
load-path)
|
||||
(add-to-list 'load-path (directory-file-name (straight--repos-dir repo)))))))
|
||||
|
||||
(defun doom-initialize-core-packages (&optional force-p)
|
||||
"Ensure `straight' is installed and was compiled with this version of Emacs."
|
||||
(when (or force-p (null (bound-and-true-p straight-recipe-repositories)))
|
||||
(doom-log "Initializing straight")
|
||||
(let ((packages (doom-package-list nil 'core)))
|
||||
(cl-destructuring-bind (&key recipe pin &allow-other-keys)
|
||||
(alist-get 'straight packages)
|
||||
(doom--ensure-straight recipe pin))
|
||||
(doom--ensure-core-packages packages))))
|
||||
|
||||
(defun doom-initialize-packages (&optional force-p)
|
||||
"Process all packages, essential and otherwise, if they haven't already been.
|
||||
|
||||
If FORCE-P is non-nil, do it anyway.
|
||||
|
||||
This ensures `doom-packages' is populated and `straight' recipes are properly
|
||||
processed."
|
||||
(doom-initialize-core-packages force-p)
|
||||
(when (or force-p (not (bound-and-true-p package--initialized)))
|
||||
(doom-log "Initializing package.el")
|
||||
(require 'package)
|
||||
(package-initialize)
|
||||
(unless package--initialized
|
||||
(error "Failed to initialize package.el")))
|
||||
(when (or force-p (null doom-packages))
|
||||
(doom-log "Initializing straight.el")
|
||||
(setq doom-disabled-packages nil
|
||||
doom-packages (doom-package-list))
|
||||
(let (packages)
|
||||
(dolist (package doom-packages)
|
||||
(cl-destructuring-bind
|
||||
(name &key recipe disable ignore &allow-other-keys) package
|
||||
(if ignore
|
||||
(straight-override-recipe (cons name '(:type built-in)))
|
||||
(if disable
|
||||
(cl-pushnew name doom-disabled-packages)
|
||||
(when recipe
|
||||
(straight-override-recipe (cons name recipe)))
|
||||
(appendq! packages (cons name (straight--get-dependencies name)))))))
|
||||
(dolist (package (cl-delete-duplicates packages :test #'equal))
|
||||
(straight-register-package package)
|
||||
(let ((name (symbol-name package)))
|
||||
(add-to-list 'load-path (directory-file-name (straight--build-dir name)))
|
||||
(straight--load-package-autoloads name))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Package management API
|
||||
|
||||
(defun doom-package-get (package &optional prop nil-value)
|
||||
"Returns PACKAGE's `package!' recipe from `doom-packages'."
|
||||
(let ((plist (cdr (assq package doom-packages))))
|
||||
(if prop
|
||||
(if (plist-member plist prop)
|
||||
(plist-get plist prop)
|
||||
nil-value)
|
||||
plist)))
|
||||
|
||||
(defun doom-package-set (package prop value)
|
||||
"Set PROPERTY in PACKAGE's recipe to VALUE."
|
||||
(setf (alist-get package doom-packages)
|
||||
(plist-put (alist-get package doom-packages)
|
||||
prop value)))
|
||||
|
||||
(defun doom-package-recipe (package &optional prop nil-value)
|
||||
"Returns the `straight' recipe PACKAGE was registered with."
|
||||
(let* ((recipe (straight-recipes-retrieve package))
|
||||
(plist (doom-plist-merge
|
||||
(plist-get (alist-get package doom-packages) :recipe)
|
||||
(cdr (if (memq (car recipe) '(quote \`))
|
||||
(eval recipe t)
|
||||
recipe)))))
|
||||
(if prop
|
||||
(if (plist-member plist prop)
|
||||
(plist-get plist prop)
|
||||
nil-value)
|
||||
plist)))
|
||||
|
||||
(defun doom-package-recipe-repo (package)
|
||||
"Resolve and return PACKAGE's (symbol) local-repo property."
|
||||
(if-let* ((recipe (copy-sequence (doom-package-recipe package)))
|
||||
(recipe (if (and (not (plist-member recipe :type))
|
||||
(memq (plist-get recipe :host) '(github gitlab bitbucket)))
|
||||
(plist-put recipe :type 'git)
|
||||
recipe))
|
||||
(repo (if-let (local-repo (plist-get recipe :local-repo))
|
||||
(directory-file-name local-repo)
|
||||
(ignore-errors (straight-vc-local-repo-name recipe)))))
|
||||
repo
|
||||
(symbol-name package)))
|
||||
|
||||
(defun doom-package-build-recipe (package &optional prop nil-value)
|
||||
"Returns the `straight' recipe PACKAGE was installed with."
|
||||
(let ((plist (nth 2 (gethash (symbol-name package) straight--build-cache))))
|
||||
(if prop
|
||||
(if (plist-member plist prop)
|
||||
(plist-get plist prop)
|
||||
nil-value)
|
||||
plist)))
|
||||
|
||||
(defun doom-package-dependencies (package &optional recursive noerror)
|
||||
"Return a list of dependencies for a package.
|
||||
|
||||
If RECURSIVE is `tree', return a tree of dependencies.
|
||||
If RECURSIVE is nil, only return PACKAGE's immediate dependencies.
|
||||
If NOERROR, return nil in case of error."
|
||||
(cl-check-type package symbol)
|
||||
(let ((deps (straight-dependencies (symbol-name package))))
|
||||
(pcase recursive
|
||||
(`tree deps)
|
||||
(`t (flatten-list deps))
|
||||
(`nil (cl-remove-if #'listp deps)))))
|
||||
|
||||
(defun doom-package-depending-on (package &optional noerror)
|
||||
"Return a list of packages that depend on PACKAGE.
|
||||
|
||||
If PACKAGE (a symbol) isn't installed, throw an error, unless NOERROR is
|
||||
non-nil."
|
||||
(cl-check-type package symbol)
|
||||
;; can't get dependencies for built-in packages
|
||||
(unless (or (doom-package-build-recipe package)
|
||||
noerror)
|
||||
(error "Couldn't find %s, is it installed?" package))
|
||||
(straight-dependents (symbol-name package)))
|
||||
|
||||
;;; Predicate functions
|
||||
(defun doom-package-built-in-p (package)
|
||||
"Return non-nil if PACKAGE (a symbol) is built-in."
|
||||
(eq (doom-package-build-recipe package :type)
|
||||
'built-in))
|
||||
|
||||
(defun doom-package-installed-p (package)
|
||||
"Return non-nil if PACKAGE (a symbol) is installed."
|
||||
(file-directory-p (straight--build-dir (symbol-name package))))
|
||||
|
||||
(defun doom-package-is-type-p (package type)
|
||||
"TODO"
|
||||
(memq type (doom-enlist (doom-package-get package :type))))
|
||||
|
||||
(defun doom-package-in-module-p (package category &optional module)
|
||||
"Return non-nil if PACKAGE was installed by the user's private config."
|
||||
(when-let (modules (doom-package-get package :modules))
|
||||
(or (and (not module) (assq :private modules))
|
||||
(member (cons category module) modules))))
|
||||
|
||||
(defun doom-package-backend (package)
|
||||
"Return 'straight, 'builtin, 'elpa or 'other, depending on how PACKAGE is
|
||||
installed."
|
||||
(cond ((gethash (symbol-name package) straight--build-cache)
|
||||
'straight)
|
||||
((or (doom-package-built-in-p package)
|
||||
(assq package package--builtins))
|
||||
'builtin)
|
||||
((assq package package-alist)
|
||||
'elpa)
|
||||
((locate-library (symbol-name package))
|
||||
'other)))
|
||||
|
||||
|
||||
;;; Package getters
|
||||
(defun doom--read-packages (file &optional noeval noerror)
|
||||
(condition-case-unless-debug e
|
||||
(with-temp-buffer ; prevent buffer-local state from propagating
|
||||
(if (not noeval)
|
||||
(load file noerror 'nomessage 'nosuffix)
|
||||
(when (file-exists-p file)
|
||||
(insert-file-contents file)
|
||||
(let (emacs-lisp-mode) (emacs-lisp-mode))
|
||||
;; Scrape `package!' blocks from FILE for a comprehensive listing of
|
||||
;; packages used by this module.
|
||||
(while (search-forward "(package!" nil t)
|
||||
(let ((ppss (save-excursion (syntax-ppss))))
|
||||
;; Don't collect packages in comments or strings
|
||||
(unless (or (nth 3 ppss)
|
||||
(nth 4 ppss))
|
||||
(goto-char (match-beginning 0))
|
||||
(cl-destructuring-bind (_ name . plist)
|
||||
(read (current-buffer))
|
||||
(push (cons
|
||||
name (plist-put
|
||||
plist :modules
|
||||
(list (doom-module-from-path file))))
|
||||
doom-packages))))))))
|
||||
(user-error
|
||||
(user-error (error-message-string e)))
|
||||
(error
|
||||
(signal 'doom-package-error
|
||||
(list (doom-module-from-path file)
|
||||
file e)))))
|
||||
|
||||
(defun doom-package-list (&optional all-p core-only-p)
|
||||
"Retrieve a list of explicitly declared packages from enabled modules.
|
||||
|
||||
If ALL-P, gather packages unconditionally across all modules, including disabled
|
||||
ones."
|
||||
(let ((packages-file (concat doom-packages-file ".el"))
|
||||
doom-disabled-packages
|
||||
doom-packages)
|
||||
(doom--read-packages
|
||||
(doom-path doom-core-dir packages-file) all-p 'noerror)
|
||||
(unless core-only-p
|
||||
(let ((private-packages (doom-path doom-private-dir packages-file))
|
||||
(doom-modules (doom-module-list)))
|
||||
(if all-p
|
||||
(mapc #'doom--read-packages
|
||||
(doom-files-in doom-modules-dir
|
||||
:depth 2
|
||||
:match "/packages\\.el$"))
|
||||
;; We load the private packages file twice to populate
|
||||
;; `doom-disabled-packages' disabled packages are seen ASAP, and a
|
||||
;; second time to ensure privately overridden packages are properly
|
||||
;; overwritten.
|
||||
(let (doom-packages)
|
||||
(doom--read-packages private-packages nil 'noerror))
|
||||
(cl-loop for key being the hash-keys of doom-modules
|
||||
for path = (doom-module-path (car key) (cdr key) packages-file)
|
||||
for doom--current-module = key
|
||||
do (doom--read-packages path nil 'noerror)))
|
||||
(doom--read-packages private-packages all-p 'noerror)))
|
||||
(cl-remove-if-not
|
||||
(if core-only-p
|
||||
(lambda (pkg) (eq (plist-get (cdr pkg) :type) 'core))
|
||||
#'identity)
|
||||
(nreverse doom-packages))))
|
||||
|
||||
(defun doom-package-pinned-list ()
|
||||
"Return an alist mapping package names (strings) to pinned commits (strings)."
|
||||
(let (alist)
|
||||
(dolist (package doom-packages alist)
|
||||
(cl-destructuring-bind (name &key disable ignore pin unpin &allow-other-keys)
|
||||
package
|
||||
(when (and (not ignore)
|
||||
(not disable)
|
||||
(or pin unpin))
|
||||
(setf (alist-get (file-name-nondirectory (doom-package-recipe-repo name))
|
||||
alist nil 'remove #'equal)
|
||||
(unless unpin pin)))))))
|
||||
|
||||
(defun doom-package-recipe-list ()
|
||||
"Return straight recipes for non-builtin packages with a local-repo."
|
||||
(let (recipes)
|
||||
(dolist (recipe (hash-table-values straight--recipe-cache))
|
||||
(cl-destructuring-bind (&key local-repo type &allow-other-keys)
|
||||
recipe
|
||||
(unless (or (null local-repo)
|
||||
(eq type 'built-in))
|
||||
(push recipe recipes))))
|
||||
(nreverse recipes)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Module package macros
|
||||
|
||||
(cl-defmacro package!
|
||||
(name &rest plist &key built-in recipe ignore _type _pin _disable)
|
||||
"Declares a package and how to install it (if applicable).
|
||||
|
||||
This macro is declarative and does not load nor install packages. It is used to
|
||||
populate `doom-packages' with metadata about the packages Doom needs to keep
|
||||
track of.
|
||||
|
||||
Only use this macro in a module's packages.el file.
|
||||
|
||||
Accepts the following properties:
|
||||
|
||||
:type core|local|built-in|virtual
|
||||
Specifies what kind of package this is. Can be a symbol or a list thereof.
|
||||
`core' = this is a protected package and cannot be disabled!
|
||||
`local' = this package is being modified in-place. This package's repo is
|
||||
unshallowed and will be skipped when you update packages.
|
||||
`built-in' = this package is already built-in (otherwise, will be
|
||||
installed)
|
||||
`virtual' = this package is not tracked by Doom's package manager. It won't
|
||||
be installed or uninstalled. Use this to pin 2nd order dependencies.
|
||||
:recipe RECIPE
|
||||
Specifies a straight.el recipe to allow you to acquire packages from external
|
||||
sources. See https://github.com/radian-software/straight.el#the-recipe-format
|
||||
for details on this recipe.
|
||||
:disable BOOL
|
||||
Do not install or update this package AND disable all of its `use-package!'
|
||||
and `after!' blocks.
|
||||
:ignore FORM
|
||||
Do not install this package.
|
||||
:pin STR|nil
|
||||
Pin this package to commit hash STR. Setting this to nil will unpin this
|
||||
package if previously pinned.
|
||||
:built-in BOOL|'prefer
|
||||
Same as :ignore if the package is a built-in Emacs package. This is more to
|
||||
inform help commands like `doom/help-packages' that this is a built-in
|
||||
package. If set to 'prefer, the package will not be installed if it is
|
||||
already provided by Emacs.
|
||||
|
||||
Returns t if package is successfully registered, and nil if it was disabled
|
||||
elsewhere."
|
||||
(declare (indent defun))
|
||||
(when (and recipe (keywordp (car-safe recipe)))
|
||||
(cl-callf plist-put plist :recipe `(quote ,recipe)))
|
||||
;; :built-in t is basically an alias for :ignore (locate-library NAME)
|
||||
(when built-in
|
||||
(when (and (not ignore)
|
||||
(equal built-in '(quote prefer)))
|
||||
(setq built-in `(locate-library ,(symbol-name name) nil (get 'load-path 'initial-value))))
|
||||
(cl-callf map-delete plist :built-in)
|
||||
(cl-callf plist-put plist :ignore built-in))
|
||||
`(let* ((name ',name)
|
||||
(plist (cdr (assq name doom-packages))))
|
||||
;; Record what module this declaration was found in
|
||||
(let ((module-list (plist-get plist :modules))
|
||||
(module ',(doom-module-from-path)))
|
||||
(unless (member module module-list)
|
||||
(cl-callf plist-put plist :modules
|
||||
(append module-list
|
||||
(list module)
|
||||
(when (file-in-directory-p ,(dir!) doom-private-dir)
|
||||
'((:private . modules)))
|
||||
nil))))
|
||||
;; Merge given plist with pre-existing one
|
||||
(cl-loop for (key value) on (list ,@plist) by 'cddr
|
||||
when value
|
||||
do (cl-callf plist-put plist key value))
|
||||
;; Some basic key validation; throws an error on invalid properties
|
||||
(condition-case e
|
||||
(when-let (recipe (plist-get plist :recipe))
|
||||
(cl-destructuring-bind
|
||||
(&key local-repo _files _flavor _build _pre-build _post-build
|
||||
_includes _type _repo _host _branch _protocol _remote
|
||||
_nonrecursive _fork _depth _source _inherit)
|
||||
recipe
|
||||
;; Expand :local-repo from current directory
|
||||
(when local-repo
|
||||
(cl-callf plist-put plist :recipe
|
||||
(plist-put recipe :local-repo
|
||||
(let ((local-path (expand-file-name local-repo ,(dir!))))
|
||||
(if (file-directory-p local-path)
|
||||
local-path
|
||||
local-repo)))))))
|
||||
(error
|
||||
(signal 'doom-package-error
|
||||
(cons ,(symbol-name name)
|
||||
(error-message-string e)))))
|
||||
;; These are the only side-effects of this macro!
|
||||
(setf (alist-get name doom-packages) plist)
|
||||
(if (plist-get plist :disable)
|
||||
(add-to-list 'doom-disabled-packages name)
|
||||
(with-no-warnings
|
||||
(cons name plist)))))
|
||||
|
||||
(defmacro disable-packages! (&rest packages)
|
||||
"A convenience macro for disabling packages in bulk.
|
||||
Only use this macro in a module's (or your private) packages.el file."
|
||||
(macroexp-progn
|
||||
(mapcar (lambda (p) `(package! ,p :disable t))
|
||||
packages)))
|
||||
|
||||
(defmacro unpin! (&rest targets)
|
||||
"Unpin packages in TARGETS.
|
||||
|
||||
This unpins packages, so that 'doom upgrade' downloads their latest version. It
|
||||
can be used one of five ways:
|
||||
|
||||
- To disable pinning wholesale: (unpin! t)
|
||||
- To unpin individual packages: (unpin! packageA packageB ...)
|
||||
- To unpin all packages in a group of modules: (unpin! :lang :tools ...)
|
||||
- To unpin packages in individual modules:
|
||||
(unpin! (:lang python javascript) (:tools docker))
|
||||
|
||||
Or any combination of the above.
|
||||
|
||||
This macro should only be used from the user's private packages.el. No module
|
||||
should use it!"
|
||||
(if (memq t targets)
|
||||
`(mapc (doom-rpartial #'doom-package-set :unpin t)
|
||||
(mapcar #'car doom-packages))
|
||||
(macroexp-progn
|
||||
(mapcar
|
||||
(lambda (target)
|
||||
(when target
|
||||
`(doom-package-set ',target :unpin t)))
|
||||
(cl-loop for target in targets
|
||||
if (or (keywordp target) (listp target))
|
||||
append
|
||||
(cl-loop with (category . modules) = (doom-enlist target)
|
||||
for (name . plist) in doom-packages
|
||||
for pkg-modules = (plist-get plist :modules)
|
||||
if (and (assq category pkg-modules)
|
||||
(or (null modules)
|
||||
(cl-loop for module in modules
|
||||
if (member (cons category module) pkg-modules)
|
||||
return t))
|
||||
name)
|
||||
collect it)
|
||||
else if (symbolp target)
|
||||
collect target)))))
|
||||
|
||||
(provide 'doom-packages)
|
||||
;;; doom-packages.el ends here
|
||||
299
lisp/doom-projects.el
Normal file
299
lisp/doom-projects.el
Normal file
|
|
@ -0,0 +1,299 @@
|
|||
;;; doom-projects.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defvar doom-projectile-cache-limit 10000
|
||||
"If any project cache surpasses this many files it is purged when quitting
|
||||
Emacs.")
|
||||
|
||||
(defvar doom-projectile-cache-blacklist '("~" "/tmp" "/")
|
||||
"Directories that should never be cached.")
|
||||
|
||||
(defvar doom-projectile-cache-purge-non-projects nil
|
||||
"If non-nil, non-projects are purged from the cache on `kill-emacs-hook'.")
|
||||
|
||||
(defvar doom-projectile-fd-binary
|
||||
(cl-find-if #'executable-find (list "fdfind" "fd"))
|
||||
"The filename of the `fd' executable. On some distros it's 'fdfind' (ubuntu,
|
||||
debian, and derivatives). On most it's 'fd'.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Packages
|
||||
|
||||
(use-package! projectile
|
||||
:commands (projectile-project-root
|
||||
projectile-project-name
|
||||
projectile-project-p
|
||||
projectile-locate-dominating-file
|
||||
projectile-relevant-known-projects)
|
||||
:init
|
||||
(setq projectile-cache-file (concat doom-cache-dir "projectile.cache")
|
||||
;; Auto-discovery is slow to do by default. Better to update the list
|
||||
;; when you need to (`projectile-discover-projects-in-search-path').
|
||||
projectile-auto-discover nil
|
||||
projectile-enable-caching (not noninteractive)
|
||||
projectile-globally-ignored-files '(".DS_Store" "TAGS")
|
||||
projectile-globally-ignored-file-suffixes '(".elc" ".pyc" ".o")
|
||||
projectile-kill-buffers-filter 'kill-only-files
|
||||
projectile-known-projects-file (concat doom-cache-dir "projectile.projects")
|
||||
projectile-ignored-projects '("~/")
|
||||
projectile-ignored-project-function #'doom-project-ignored-p)
|
||||
|
||||
(global-set-key [remap evil-jump-to-tag] #'projectile-find-tag)
|
||||
(global-set-key [remap find-tag] #'projectile-find-tag)
|
||||
|
||||
:config
|
||||
(projectile-mode +1)
|
||||
|
||||
;; Auto-discovery on `projectile-mode' is slow and premature. Let's defer it
|
||||
;; until it's actually needed. Also clean up non-existing projects too!
|
||||
(add-transient-hook! 'projectile-relevant-known-projects
|
||||
(projectile-cleanup-known-projects)
|
||||
(projectile-discover-projects-in-search-path))
|
||||
|
||||
;; Projectile runs four functions to determine the root (in this order):
|
||||
;;
|
||||
;; + `projectile-root-local' -> checks the `projectile-project-root' variable
|
||||
;; for an explicit path.
|
||||
;; + `projectile-root-bottom-up' -> searches from / to your current directory
|
||||
;; for the paths listed in `projectile-project-root-files-bottom-up'. This
|
||||
;; includes .git and .project
|
||||
;; + `projectile-root-top-down' -> searches from the current directory down to
|
||||
;; / the paths listed in `projectile-root-files', like package.json,
|
||||
;; setup.py, or Cargo.toml
|
||||
;; + `projectile-root-top-down-recurring' -> searches from the current
|
||||
;; directory down to / for a directory that has one of
|
||||
;; `projectile-project-root-files-top-down-recurring' but doesn't have a
|
||||
;; parent directory with the same file.
|
||||
;;
|
||||
;; In the interest of performance, we reduce the number of project root marker
|
||||
;; files/directories projectile searches for when resolving the project root.
|
||||
(setq projectile-project-root-files-bottom-up
|
||||
(append '(".projectile" ; projectile's root marker
|
||||
".project" ; doom project marker
|
||||
".git") ; Git VCS root dir
|
||||
(when (executable-find "hg")
|
||||
'(".hg")) ; Mercurial VCS root dir
|
||||
(when (executable-find "bzr")
|
||||
'(".bzr"))) ; Bazaar VCS root dir
|
||||
;; This will be filled by other modules. We build this list manually so
|
||||
;; projectile doesn't perform so many file checks every time it resolves
|
||||
;; a project's root -- particularly when a file has no project.
|
||||
projectile-project-root-files '()
|
||||
projectile-project-root-files-top-down-recurring '("Makefile"))
|
||||
|
||||
(push (abbreviate-file-name doom-local-dir) projectile-globally-ignored-directories)
|
||||
|
||||
;; Per-project compilation buffers
|
||||
(setq compilation-buffer-name-function #'projectile-compilation-buffer-name
|
||||
compilation-save-buffers-predicate #'projectile-current-project-buffer-p)
|
||||
|
||||
;; Support the more generic .project files as an alternative to .projectile
|
||||
(defadvice! doom--projectile-dirconfig-file-a ()
|
||||
:override #'projectile-dirconfig-file
|
||||
(cond ((file-exists-p! (or ".projectile" ".project") (projectile-project-root)))
|
||||
((expand-file-name ".project" (projectile-project-root)))))
|
||||
|
||||
;; Disable commands that won't work, as is, and that Doom already provides a
|
||||
;; better alternative for.
|
||||
(put 'projectile-ag 'disabled "Use +default/search-project instead")
|
||||
(put 'projectile-ripgrep 'disabled "Use +default/search-project instead")
|
||||
(put 'projectile-grep 'disabled "Use +default/search-project instead")
|
||||
|
||||
;; Treat current directory in dired as a "file in a project" and track it
|
||||
(add-hook 'dired-before-readin-hook #'projectile-track-known-projects-find-file-hook)
|
||||
|
||||
;; Accidentally indexing big directories like $HOME or / will massively bloat
|
||||
;; projectile's cache (into the hundreds of MBs). This purges those entries
|
||||
;; when exiting Emacs to prevent slowdowns/freezing when cache files are
|
||||
;; loaded or written to.
|
||||
(add-hook! 'kill-emacs-hook
|
||||
(defun doom-cleanup-project-cache-h ()
|
||||
"Purge projectile cache entries that:
|
||||
|
||||
a) have too many files (see `doom-projectile-cache-limit'),
|
||||
b) represent blacklisted directories that are too big, change too often or are
|
||||
private. (see `doom-projectile-cache-blacklist'),
|
||||
c) are not valid projectile projects."
|
||||
(when (and (bound-and-true-p projectile-projects-cache)
|
||||
projectile-enable-caching)
|
||||
(setq projectile-known-projects
|
||||
(cl-remove-if #'projectile-ignored-project-p
|
||||
projectile-known-projects))
|
||||
(projectile-cleanup-known-projects)
|
||||
(cl-loop with blacklist = (mapcar #'file-truename doom-projectile-cache-blacklist)
|
||||
for proot in (hash-table-keys projectile-projects-cache)
|
||||
if (or (not (stringp proot))
|
||||
(string-empty-p proot)
|
||||
(>= (length (gethash proot projectile-projects-cache))
|
||||
doom-projectile-cache-limit)
|
||||
(member (substring proot 0 -1) blacklist)
|
||||
(and doom-projectile-cache-purge-non-projects
|
||||
(not (doom-project-p proot)))
|
||||
(projectile-ignored-project-p proot))
|
||||
do (doom-log "Removed %S from projectile cache" proot)
|
||||
and do (remhash proot projectile-projects-cache)
|
||||
and do (remhash proot projectile-projects-cache-time)
|
||||
and do (remhash proot projectile-project-type-cache))
|
||||
(projectile-serialize-cache))))
|
||||
|
||||
;; Some MSYS utilities auto expanded the `/' path separator, so we need to prevent it.
|
||||
(when IS-WINDOWS
|
||||
(setenv "MSYS_NO_PATHCONV" "1") ; Fix path in Git Bash
|
||||
(setenv "MSYS2_ARG_CONV_EXCL" "--path-separator")) ; Fix path in MSYS2
|
||||
|
||||
;; HACK Don't rely on VCS-specific commands to generate our file lists. That's
|
||||
;; 7 commands to maintain, versus the more generic, reliable and
|
||||
;; performant `fd' or `ripgrep'.
|
||||
(defadvice! doom--only-use-generic-command-a (fn vcs)
|
||||
"Only use `projectile-generic-command' for indexing project files.
|
||||
And if it's a function, evaluate it."
|
||||
:around #'projectile-get-ext-command
|
||||
(if (and (functionp projectile-generic-command)
|
||||
(not (file-remote-p default-directory)))
|
||||
(funcall projectile-generic-command vcs)
|
||||
(let ((projectile-git-submodule-command
|
||||
(get 'projectile-git-submodule-command 'initial-value)))
|
||||
(funcall fn vcs))))
|
||||
|
||||
;; `projectile-generic-command' doesn't typically support a function, but my
|
||||
;; `doom--only-use-generic-command-a' advice allows this. I do it this way so
|
||||
;; that projectile can adapt to remote systems (over TRAMP), rather then look
|
||||
;; for fd/ripgrep on the remote system simply because it exists on the host.
|
||||
;; It's faster too.
|
||||
(put 'projectile-git-submodule-command 'initial-value projectile-git-submodule-command)
|
||||
(setq projectile-git-submodule-command nil
|
||||
projectile-indexing-method 'hybrid
|
||||
projectile-generic-command
|
||||
(lambda (_)
|
||||
;; If fd exists, use it for git and generic projects. fd is a rust
|
||||
;; program that is significantly faster than git ls-files or find, and
|
||||
;; it respects .gitignore. This is recommended in the projectile docs.
|
||||
(cond
|
||||
((when-let
|
||||
(bin (if (ignore-errors (file-remote-p default-directory nil t))
|
||||
(cl-find-if (doom-rpartial #'executable-find t)
|
||||
(list "fdfind" "fd"))
|
||||
doom-projectile-fd-binary))
|
||||
(concat (format "%s . -0 -H --color=never --type file --type symlink --follow --exclude .git --strip-cwd-prefix"
|
||||
bin)
|
||||
(if IS-WINDOWS " --path-separator=/"))))
|
||||
;; Otherwise, resort to ripgrep, which is also faster than find
|
||||
((executable-find "rg" t)
|
||||
(concat "rg -0 --files --follow --color=never --hidden -g!.git"
|
||||
(if IS-WINDOWS " --path-separator=/")))
|
||||
("find . -type f -print0"))))
|
||||
|
||||
(defadvice! doom--projectile-default-generic-command-a (fn &rest args)
|
||||
"If projectile can't tell what kind of project you're in, it issues an error
|
||||
when using many of projectile's command, e.g. `projectile-compile-command',
|
||||
`projectile-run-project', `projectile-test-project', and
|
||||
`projectile-configure-project', for instance.
|
||||
|
||||
This suppresses the error so these commands will still run, but prompt you for
|
||||
the command instead."
|
||||
:around #'projectile-default-generic-command
|
||||
(ignore-errors (apply fn args))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Project-based minor modes
|
||||
|
||||
(defvar doom-project-hook nil
|
||||
"Hook run when a project is enabled. The name of the project's mode and its
|
||||
state are passed in.")
|
||||
|
||||
(cl-defmacro def-project-mode! (name &key
|
||||
modes
|
||||
files
|
||||
when
|
||||
match
|
||||
add-hooks
|
||||
on-load
|
||||
on-enter
|
||||
on-exit)
|
||||
"Define a project minor mode named NAME and where/how it is activated.
|
||||
|
||||
Project modes allow you to configure 'sub-modes' for major-modes that are
|
||||
specific to a folder, project structure, framework or whatever arbitrary context
|
||||
you define. These project modes can have their own settings, keymaps, hooks,
|
||||
snippets, etc.
|
||||
|
||||
This creates NAME-hook and NAME-map as well.
|
||||
|
||||
PLIST may contain any of these properties, which are all checked to see if NAME
|
||||
should be activated. If they are *all* true, NAME is activated.
|
||||
|
||||
:modes MODES -- if buffers are derived from MODES (one or a list of symbols).
|
||||
|
||||
:files FILES -- if project contains FILES; takes a string or a form comprised
|
||||
of nested (and ...) and/or (or ...) forms. Each path is relative to the
|
||||
project root, however, if prefixed with a '.' or '..', it is relative to the
|
||||
current buffer.
|
||||
|
||||
:match REGEXP -- if file name matches REGEXP
|
||||
|
||||
:when PREDICATE -- if PREDICATE returns true (can be a form or the symbol of a
|
||||
function)
|
||||
|
||||
:add-hooks HOOKS -- HOOKS is a list of hooks to add this mode's hook.
|
||||
|
||||
:on-load FORM -- FORM to run the first time this project mode is enabled.
|
||||
|
||||
:on-enter FORM -- FORM is run each time the mode is activated.
|
||||
|
||||
:on-exit FORM -- FORM is run each time the mode is disabled.
|
||||
|
||||
Relevant: `doom-project-hook'."
|
||||
(declare (indent 1))
|
||||
(let ((init-var (intern (format "%s-init" name))))
|
||||
(macroexp-progn
|
||||
(append
|
||||
(when on-load
|
||||
`((defvar ,init-var nil)))
|
||||
`((define-minor-mode ,name
|
||||
"A project minor mode generated by `def-project-mode!'."
|
||||
:init-value nil
|
||||
:lighter ""
|
||||
:keymap (make-sparse-keymap)
|
||||
(if (not ,name)
|
||||
,on-exit
|
||||
(run-hook-with-args 'doom-project-hook ',name ,name)
|
||||
,(when on-load
|
||||
`(unless ,init-var
|
||||
,on-load
|
||||
(setq ,init-var t)))
|
||||
,on-enter))
|
||||
(dolist (hook ,add-hooks)
|
||||
(add-hook ',(intern (format "%s-hook" name)) hook)))
|
||||
(cond ((or files modes when)
|
||||
(cl-check-type files (or null list string))
|
||||
(let ((fn
|
||||
`(lambda ()
|
||||
(and (not (bound-and-true-p ,name))
|
||||
(and buffer-file-name (not (file-remote-p buffer-file-name nil t)))
|
||||
,(or (null match)
|
||||
`(if buffer-file-name (string-match-p ,match buffer-file-name)))
|
||||
,(or (null files)
|
||||
;; Wrap this in `eval' to prevent eager expansion
|
||||
;; of `project-file-exists-p!' from pulling in
|
||||
;; autoloaded files prematurely.
|
||||
`(eval
|
||||
'(project-file-exists-p!
|
||||
,(if (stringp (car files)) (cons 'and files) files))))
|
||||
,(or when t)
|
||||
(,name 1)))))
|
||||
(if modes
|
||||
`((dolist (mode ,modes)
|
||||
(let ((hook-name
|
||||
(intern (format "doom--enable-%s%s-h" ',name
|
||||
(if (eq mode t) "" (format "-in-%s" mode))))))
|
||||
(fset hook-name #',fn)
|
||||
(if (eq mode t)
|
||||
(add-to-list 'auto-minor-mode-magic-alist (cons hook-name #',name))
|
||||
(add-hook (intern (format "%s-hook" mode)) hook-name)))))
|
||||
`((add-hook 'change-major-mode-after-body-hook #',fn)))))
|
||||
(match
|
||||
`((add-to-list 'auto-minor-mode-alist (cons ,match #',name)))))))))
|
||||
|
||||
(provide 'doom-projects)
|
||||
;;; doom-projects.el ends here
|
||||
201
lisp/doom-start.el
Normal file
201
lisp/doom-start.el
Normal file
|
|
@ -0,0 +1,201 @@
|
|||
;;; lisp/doom-start.el --- bootstrapper for interactive sessions -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
(require 'doom-modules)
|
||||
|
||||
|
||||
;;
|
||||
;;; Reasonable defaults for interactive sessions
|
||||
|
||||
;; GUIs are inconsistent across systems, will rarely match our active Emacs
|
||||
;; theme, and impose their shortcut key paradigms suddenly. Let's just avoid
|
||||
;; them altogether and have Emacs handle the prompting.
|
||||
(setq use-dialog-box nil)
|
||||
(when (bound-and-true-p tooltip-mode)
|
||||
(tooltip-mode -1))
|
||||
(when IS-LINUX
|
||||
(setq x-gtk-use-system-tooltips nil))
|
||||
|
||||
;; Favor vertical splits over horizontal ones, since monitors are trending
|
||||
;; toward wide rather than tall.
|
||||
(setq split-width-threshold 160
|
||||
split-height-threshold nil)
|
||||
|
||||
|
||||
;;
|
||||
;;; MODE-local-vars-hook
|
||||
|
||||
;; File+dir local variables are initialized after the major mode and its hooks
|
||||
;; have run. If you want hook functions to be aware of these customizations, add
|
||||
;; them to MODE-local-vars-hook instead.
|
||||
(defvar doom-inhibit-local-var-hooks nil)
|
||||
|
||||
(defun doom-run-local-var-hooks-h ()
|
||||
"Run MODE-local-vars-hook after local variables are initialized."
|
||||
(unless (or doom-inhibit-local-var-hooks delay-mode-hooks)
|
||||
(setq-local doom-inhibit-local-var-hooks t)
|
||||
(doom-run-hooks (intern (format "%s-local-vars-hook" major-mode)))))
|
||||
|
||||
;; If the user has disabled `enable-local-variables', then
|
||||
;; `hack-local-variables-hook' is never triggered, so we trigger it at the end
|
||||
;; of `after-change-major-mode-hook':
|
||||
(defun doom-run-local-var-hooks-maybe-h ()
|
||||
"Run `doom-run-local-var-hooks-h' if `enable-local-variables' is disabled."
|
||||
(unless enable-local-variables
|
||||
(doom-run-local-var-hooks-h)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Incremental lazy-loading
|
||||
|
||||
(defvar doom-incremental-packages '(t)
|
||||
"A list of packages to load incrementally after startup. Any large packages
|
||||
here may cause noticeable pauses, so it's recommended you break them up into
|
||||
sub-packages. For example, `org' is comprised of many packages, and can be
|
||||
broken up into:
|
||||
|
||||
(doom-load-packages-incrementally
|
||||
'(calendar find-func format-spec org-macs org-compat
|
||||
org-faces org-entities org-list org-pcomplete org-src
|
||||
org-footnote org-macro ob org org-clock org-agenda
|
||||
org-capture))
|
||||
|
||||
This is already done by the lang/org module, however.
|
||||
|
||||
If you want to disable incremental loading altogether, either remove
|
||||
`doom-load-packages-incrementally-h' from `emacs-startup-hook' or set
|
||||
`doom-incremental-first-idle-timer' to nil. Incremental loading does not occur
|
||||
in daemon sessions (they are loaded immediately at startup).")
|
||||
|
||||
(defvar doom-incremental-first-idle-timer 2.0
|
||||
"How long (in idle seconds) until incremental loading starts.
|
||||
|
||||
Set this to nil to disable incremental loading.")
|
||||
|
||||
(defvar doom-incremental-idle-timer 0.75
|
||||
"How long (in idle seconds) in between incrementally loading packages.")
|
||||
|
||||
(defvar doom-incremental-load-immediately (daemonp)
|
||||
"If non-nil, load all incrementally deferred packages immediately at startup.")
|
||||
|
||||
(defun doom-load-packages-incrementally (packages &optional now)
|
||||
"Registers PACKAGES to be loaded incrementally.
|
||||
|
||||
If NOW is non-nil, load PACKAGES incrementally, in `doom-incremental-idle-timer'
|
||||
intervals."
|
||||
(if (not now)
|
||||
(appendq! doom-incremental-packages packages)
|
||||
(while packages
|
||||
(let* ((gc-cons-threshold most-positive-fixnum)
|
||||
(req (pop packages)))
|
||||
(unless (featurep req)
|
||||
(doom-log "Incrementally loading %s" req)
|
||||
(condition-case-unless-debug e
|
||||
(or (while-no-input
|
||||
;; If `default-directory' is a directory that doesn't exist
|
||||
;; or is unreadable, Emacs throws up file-missing errors, so
|
||||
;; we set it to a directory we know exists and is readable.
|
||||
(let ((default-directory doom-emacs-dir)
|
||||
(inhibit-message t)
|
||||
file-name-handler-alist)
|
||||
(require req nil t))
|
||||
t)
|
||||
(push req packages))
|
||||
(error
|
||||
(message "Failed to load %S package incrementally, because: %s"
|
||||
req e)))
|
||||
(if (not packages)
|
||||
(doom-log "Finished incremental loading")
|
||||
(run-with-idle-timer doom-incremental-idle-timer
|
||||
nil #'doom-load-packages-incrementally
|
||||
packages t)
|
||||
(setq packages nil)))))))
|
||||
|
||||
(defun doom-load-packages-incrementally-h ()
|
||||
"Begin incrementally loading packages in `doom-incremental-packages'.
|
||||
|
||||
If this is a daemon session, load them all immediately instead."
|
||||
(if doom-incremental-load-immediately
|
||||
(mapc #'require (cdr doom-incremental-packages))
|
||||
(when (numberp doom-incremental-first-idle-timer)
|
||||
(run-with-idle-timer doom-incremental-first-idle-timer
|
||||
nil #'doom-load-packages-incrementally
|
||||
(cdr doom-incremental-packages) t))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Let 'er rip
|
||||
|
||||
(defvar doom-init-time nil
|
||||
"The time it took, in seconds, for Doom Emacs to initialize.")
|
||||
|
||||
(defun doom-display-benchmark-h (&optional return-p)
|
||||
"Display a benchmark including number of packages and modules loaded.
|
||||
|
||||
If RETURN-P, return the message as a string instead of displaying it."
|
||||
(funcall (if return-p #'format #'message)
|
||||
"Doom loaded %d packages across %d modules in %.03fs"
|
||||
(- (length load-path) (length (get 'load-path 'initial-value)))
|
||||
(hash-table-count doom-modules)
|
||||
(or doom-init-time
|
||||
(setq doom-init-time
|
||||
(float-time (time-subtract (current-time) before-init-time))))))
|
||||
|
||||
;; Add support for additional file extensions.
|
||||
(dolist (entry '(("/LICENSE\\'" . text-mode)
|
||||
("\\.log\\'" . text-mode)
|
||||
("rc\\'" . conf-mode)
|
||||
("\\.\\(?:hex\\|nes\\)\\'" . hexl-mode)))
|
||||
(push entry auto-mode-alist))
|
||||
|
||||
;; Doom caches a lot of information in `doom-autoloads-file'. Module and package
|
||||
;; autoloads, autodefs like `set-company-backend!', and variables like
|
||||
;; `doom-modules', `doom-disabled-packages', `load-path', `auto-mode-alist', and
|
||||
;; `Info-directory-list'. etc. Compiling them into one place is a big reduction
|
||||
;; in startup time.
|
||||
(condition-case-unless-debug e
|
||||
;; Avoid `file-name-sans-extension' for premature optimization reasons.
|
||||
;; `string-remove-suffix' is cheaper because it performs no file sanity
|
||||
;; checks; just plain ol' string manipulation.
|
||||
(load (string-remove-suffix ".el" doom-autoloads-file) nil 'nomessage)
|
||||
(file-missing
|
||||
;; If the autoloads file fails to load then the user forgot to sync, or
|
||||
;; aborted a doom command midway!
|
||||
(if (locate-file doom-autoloads-file load-path)
|
||||
;; Something inside the autoloads file is triggering this error;
|
||||
;; forward it to the caller!
|
||||
(signal 'doom-autoload-error e)
|
||||
(signal 'doom-error
|
||||
(list "Doom is in an incomplete state"
|
||||
"run 'doom sync' on the command line to repair it")))))
|
||||
|
||||
(when (and (or (display-graphic-p)
|
||||
(daemonp))
|
||||
doom-env-file)
|
||||
(setq-default process-environment (get 'process-environment 'initial-value))
|
||||
(doom-load-envvars-file doom-env-file 'noerror))
|
||||
|
||||
;; Bootstrap the interactive session
|
||||
(add-hook 'after-change-major-mode-hook #'doom-run-local-var-hooks-h 100)
|
||||
(add-hook 'hack-local-variables-hook #'doom-run-local-var-hooks-h)
|
||||
(add-hook 'emacs-startup-hook #'doom-load-packages-incrementally-h)
|
||||
(add-hook 'window-setup-hook #'doom-display-benchmark-h 105)
|
||||
(doom-run-hook-on 'doom-first-buffer-hook '(find-file-hook doom-switch-buffer-hook))
|
||||
(doom-run-hook-on 'doom-first-file-hook '(find-file-hook dired-initial-position-hook))
|
||||
(doom-run-hook-on 'doom-first-input-hook '(pre-command-hook))
|
||||
|
||||
(add-hook 'doom-first-buffer-hook #'gcmh-mode)
|
||||
|
||||
;; There's a chance the user will later use package.el or straight in this
|
||||
;; interactive session. If they do, make sure they're properly initialized
|
||||
;; when they do.
|
||||
(autoload 'doom-initialize-packages "doom-packages")
|
||||
(eval-after-load 'package '(require 'doom-packages))
|
||||
(eval-after-load 'straight '(doom-initialize-packages))
|
||||
|
||||
;; Load all things.
|
||||
(doom-initialize-modules)
|
||||
|
||||
(provide 'doom-start)
|
||||
;;; doom-start.el ends here
|
||||
667
lisp/doom-ui.el
Normal file
667
lisp/doom-ui.el
Normal file
|
|
@ -0,0 +1,667 @@
|
|||
;;; doom-ui.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
(defvar doom-theme nil
|
||||
"A symbol representing the Emacs theme to load at startup.
|
||||
|
||||
Set to `nil' to load no theme at all. This variable is changed by
|
||||
`load-theme'.")
|
||||
|
||||
(defvar doom-font nil
|
||||
"The default font to use.
|
||||
Must be a `font-spec', a font object, an XFT font string, or an XLFD string.
|
||||
|
||||
This affects the `default' and `fixed-pitch' faces.
|
||||
|
||||
Examples:
|
||||
(setq doom-font (font-spec :family \"Fira Mono\" :size 12))
|
||||
(setq doom-font \"Terminus (TTF):pixelsize=12:antialias=off\")
|
||||
(setq doom-font \"Fira Code-14\")")
|
||||
|
||||
(defvar doom-variable-pitch-font nil
|
||||
"The default font to use for variable-pitch text.
|
||||
Must be a `font-spec', a font object, an XFT font string, or an XLFD string. See
|
||||
`doom-font' for examples.
|
||||
|
||||
An omitted font size means to inherit `doom-font''s size.")
|
||||
|
||||
(defvar doom-serif-font nil
|
||||
"The default font to use for the `fixed-pitch-serif' face.
|
||||
Must be a `font-spec', a font object, an XFT font string, or an XLFD string. See
|
||||
`doom-font' for examples.
|
||||
|
||||
An omitted font size means to inherit `doom-font''s size.")
|
||||
|
||||
(defvar doom-unicode-font nil
|
||||
"Fallback font for Unicode glyphs.
|
||||
Must be a `font-spec', a font object, an XFT font string, or an XLFD string. See
|
||||
`doom-font' for examples.
|
||||
|
||||
The defaults on macOS and Linux are Apple Color Emoji and Symbola, respectively.
|
||||
|
||||
WARNING: if you specify a size for this font it will hard-lock any usage of this
|
||||
font to that size. It's rarely a good idea to do so!")
|
||||
|
||||
(defvar doom-emoji-fallback-font-families
|
||||
'("Apple Color Emoji"
|
||||
"Segoe UI Emoji"
|
||||
"Noto Color Emoji"
|
||||
"Noto Emoji")
|
||||
"A list of fallback font families to use for emojis.")
|
||||
|
||||
(defvar doom-symbol-fallback-font-families
|
||||
'("Segoe UI Symbol"
|
||||
"Apple Symbols")
|
||||
"A list of fallback font families for general symbol glyphs.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Custom hooks
|
||||
|
||||
(defvar doom-init-ui-hook nil
|
||||
"List of hooks to run when the UI has been initialized.")
|
||||
|
||||
(defvar doom-load-theme-hook nil
|
||||
"Hook run after the theme is loaded with `load-theme' or reloaded with
|
||||
`doom/reload-theme'.")
|
||||
|
||||
(defvar doom-switch-buffer-hook nil
|
||||
"A list of hooks run after changing the current buffer.")
|
||||
|
||||
(defvar doom-switch-window-hook nil
|
||||
"A list of hooks run after changing the focused windows.")
|
||||
|
||||
(defvar doom-switch-frame-hook nil
|
||||
"A list of hooks run after changing the focused frame.")
|
||||
|
||||
(defun doom-run-switch-buffer-hooks-h (&optional _)
|
||||
(let ((gc-cons-threshold most-positive-fixnum)
|
||||
(inhibit-redisplay t))
|
||||
(run-hooks 'doom-switch-buffer-hook)))
|
||||
|
||||
(defvar doom--last-frame nil)
|
||||
(defun doom-run-switch-window-or-frame-hooks-h (&optional _)
|
||||
(let ((gc-cons-threshold most-positive-fixnum)
|
||||
(inhibit-redisplay t))
|
||||
(unless (equal (old-selected-frame) (selected-frame))
|
||||
(run-hooks 'doom-switch-frame-hook))
|
||||
(unless (or (minibufferp)
|
||||
(equal (old-selected-window) (minibuffer-window)))
|
||||
(run-hooks 'doom-switch-window-hook))))
|
||||
|
||||
(defun doom-protect-fallback-buffer-h ()
|
||||
"Don't kill the scratch buffer. Meant for `kill-buffer-query-functions'."
|
||||
(not (eq (current-buffer) (doom-fallback-buffer))))
|
||||
|
||||
(defun doom-highlight-non-default-indentation-h ()
|
||||
"Highlight whitespace at odds with `indent-tabs-mode'.
|
||||
That is, highlight tabs if `indent-tabs-mode' is `nil', and highlight spaces at
|
||||
the beginnings of lines if `indent-tabs-mode' is `t'. The purpose is to make
|
||||
incorrect indentation in the current buffer obvious to you.
|
||||
|
||||
Does nothing if `whitespace-mode' or `global-whitespace-mode' is already active
|
||||
or if the current buffer is read-only or not file-visiting."
|
||||
(unless (or (eq major-mode 'fundamental-mode)
|
||||
(bound-and-true-p global-whitespace-mode)
|
||||
(null buffer-file-name))
|
||||
(require 'whitespace)
|
||||
(set (make-local-variable 'whitespace-style)
|
||||
(cl-union (if indent-tabs-mode
|
||||
'(indentation)
|
||||
'(tabs tab-mark))
|
||||
(when whitespace-mode
|
||||
(remq 'face whitespace-active-style))))
|
||||
(cl-pushnew 'face whitespace-style) ; must be first
|
||||
(whitespace-mode +1)))
|
||||
|
||||
|
||||
;;
|
||||
;;; General UX
|
||||
|
||||
;; A simple confirmation prompt when killing Emacs. But only prompt when there
|
||||
;; are real buffers open.
|
||||
(setq confirm-kill-emacs #'doom-quit-p)
|
||||
;; Prompt for confirmation when deleting a non-empty frame; a last line of
|
||||
;; defense against accidental loss of work.
|
||||
(global-set-key [remap delete-frame] #'doom/delete-frame-with-prompt)
|
||||
|
||||
;; Don't prompt for confirmation when we create a new file or buffer (assume the
|
||||
;; user knows what they're doing).
|
||||
(setq confirm-nonexistent-file-or-buffer nil)
|
||||
|
||||
(setq uniquify-buffer-name-style 'forward
|
||||
;; no beeping or blinking please
|
||||
ring-bell-function #'ignore
|
||||
visible-bell nil)
|
||||
|
||||
;; middle-click paste at point, not at click
|
||||
(setq mouse-yank-at-point t)
|
||||
|
||||
;; Larger column width for function name in profiler reports
|
||||
(after! profiler
|
||||
(setf (caar profiler-report-cpu-line-format) 80
|
||||
(caar profiler-report-memory-line-format) 80))
|
||||
|
||||
|
||||
;;
|
||||
;;; Scrolling
|
||||
|
||||
(setq hscroll-margin 2
|
||||
hscroll-step 1
|
||||
;; Emacs spends too much effort recentering the screen if you scroll the
|
||||
;; cursor more than N lines past window edges (where N is the settings of
|
||||
;; `scroll-conservatively'). This is especially slow in larger files
|
||||
;; during large-scale scrolling commands. If kept over 100, the window is
|
||||
;; never automatically recentered.
|
||||
scroll-conservatively 101
|
||||
scroll-margin 0
|
||||
scroll-preserve-screen-position t
|
||||
;; Reduce cursor lag by a tiny bit by not auto-adjusting `window-vscroll'
|
||||
;; for tall lines.
|
||||
auto-window-vscroll nil
|
||||
;; mouse
|
||||
mouse-wheel-scroll-amount '(2 ((shift) . hscroll))
|
||||
mouse-wheel-scroll-amount-horizontal 2)
|
||||
|
||||
|
||||
;;
|
||||
;;; Cursor
|
||||
|
||||
;; The blinking cursor is distracting, but also interferes with cursor settings
|
||||
;; in some minor modes that try to change it buffer-locally (like treemacs) and
|
||||
;; can cause freezing for folks (esp on macOS) with customized & color cursors.
|
||||
(blink-cursor-mode -1)
|
||||
|
||||
;; Don't blink the paren matching the one at point, it's too distracting.
|
||||
(setq blink-matching-paren nil)
|
||||
|
||||
;; Don't stretch the cursor to fit wide characters, it is disorienting,
|
||||
;; especially for tabs.
|
||||
(setq x-stretch-cursor nil)
|
||||
|
||||
|
||||
;;
|
||||
;;; Buffers
|
||||
|
||||
;; Make `next-buffer', `other-buffer', etc. ignore unreal buffers.
|
||||
(push '(buffer-predicate . doom-buffer-frame-predicate) default-frame-alist)
|
||||
|
||||
(defadvice! doom--switch-to-fallback-buffer-maybe-a (&rest _)
|
||||
"Switch to `doom-fallback-buffer' if on last real buffer.
|
||||
|
||||
Advice for `kill-current-buffer'. If in a dedicated window, delete it. If there
|
||||
are no real buffers left OR if all remaining buffers are visible in other
|
||||
windows, switch to `doom-fallback-buffer'. Otherwise, delegate to original
|
||||
`kill-current-buffer'."
|
||||
:before-until #'kill-current-buffer
|
||||
(let ((buf (current-buffer)))
|
||||
(cond ((window-dedicated-p)
|
||||
(delete-window)
|
||||
t)
|
||||
((eq buf (doom-fallback-buffer))
|
||||
(message "Can't kill the fallback buffer.")
|
||||
t)
|
||||
((doom-real-buffer-p buf)
|
||||
(let ((visible-p (delq (selected-window) (get-buffer-window-list buf nil t))))
|
||||
(unless visible-p
|
||||
(when (and (buffer-modified-p buf)
|
||||
(not (y-or-n-p
|
||||
(format "Buffer %s is modified; kill anyway?"
|
||||
buf))))
|
||||
(user-error "Aborted")))
|
||||
(let ((inhibit-redisplay t)
|
||||
buffer-list-update-hook)
|
||||
(when (or ;; if there aren't more real buffers than visible buffers,
|
||||
;; then there are no real, non-visible buffers left.
|
||||
(not (cl-set-difference (doom-real-buffer-list)
|
||||
(doom-visible-buffers)))
|
||||
;; if we end up back where we start (or previous-buffer
|
||||
;; returns nil), we have nowhere left to go
|
||||
(memq (switch-to-prev-buffer nil t) (list buf 'nil)))
|
||||
(switch-to-buffer (doom-fallback-buffer)))
|
||||
(unless visible-p
|
||||
(with-current-buffer buf
|
||||
(restore-buffer-modified-p nil))
|
||||
(kill-buffer buf)))
|
||||
(run-hooks 'buffer-list-update-hook)
|
||||
t)))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Fringes
|
||||
|
||||
;; Reduce the clutter in the fringes; we'd like to reserve that space for more
|
||||
;; useful information, like git-gutter and flycheck.
|
||||
(setq indicate-buffer-boundaries nil
|
||||
indicate-empty-lines nil)
|
||||
|
||||
|
||||
;;
|
||||
;;; Windows/frames
|
||||
|
||||
;; A simple frame title
|
||||
(setq frame-title-format '("%b – Doom Emacs")
|
||||
icon-title-format frame-title-format)
|
||||
|
||||
;; Don't resize the frames in steps; it looks weird, especially in tiling window
|
||||
;; managers, where it can leave unseemly gaps.
|
||||
(setq frame-resize-pixelwise t)
|
||||
|
||||
;; But do not resize windows pixelwise, this can cause crashes in some cases
|
||||
;; when resizing too many windows at once or rapidly.
|
||||
(setq window-resize-pixelwise nil)
|
||||
|
||||
;; Disable tool, menu, and scrollbars. Doom is designed to be keyboard-centric,
|
||||
;; so these are just clutter (the scrollbar also impacts performance). Whats
|
||||
;; more, the menu bar exposes functionality that Doom doesn't endorse.
|
||||
;;
|
||||
;; I am intentionally not calling `menu-bar-mode', `tool-bar-mode', and
|
||||
;; `scroll-bar-mode' because they do extra and unnecessary work that can be more
|
||||
;; concisely and efficiently expressed with these six lines:
|
||||
(push '(menu-bar-lines . 0) default-frame-alist)
|
||||
(push '(tool-bar-lines . 0) default-frame-alist)
|
||||
(push '(vertical-scroll-bars) default-frame-alist)
|
||||
;; And set these to nil so users don't have to toggle the modes twice to
|
||||
;; reactivate them.
|
||||
(setq menu-bar-mode nil
|
||||
tool-bar-mode nil
|
||||
scroll-bar-mode nil)
|
||||
|
||||
;; The native border "consumes" a pixel of the fringe on righter-most splits,
|
||||
;; `window-divider' does not. Available since Emacs 25.1.
|
||||
(setq window-divider-default-places t
|
||||
window-divider-default-bottom-width 1
|
||||
window-divider-default-right-width 1)
|
||||
(add-hook 'doom-init-ui-hook #'window-divider-mode)
|
||||
|
||||
;; GUIs are inconsistent across systems and themes (and will rarely match our
|
||||
;; active Emacs theme). They impose inconsistent shortcut key paradigms too.
|
||||
;; It's best to avoid them altogether and have Emacs handle the prompting.
|
||||
(setq use-dialog-box nil)
|
||||
(when (bound-and-true-p tooltip-mode)
|
||||
(tooltip-mode -1))
|
||||
(when IS-LINUX
|
||||
(setq x-gtk-use-system-tooltips nil))
|
||||
|
||||
;; Favor vertical splits over horizontal ones. Monitors are trending toward
|
||||
;; wide, rather than tall.
|
||||
(setq split-width-threshold 160
|
||||
split-height-threshold nil)
|
||||
|
||||
|
||||
;;
|
||||
;;; Minibuffer
|
||||
|
||||
;; Allow for minibuffer-ception. Sometimes we need another minibuffer command
|
||||
;; while we're in the minibuffer.
|
||||
(setq enable-recursive-minibuffers t)
|
||||
|
||||
;; Show current key-sequence in minibuffer ala 'set showcmd' in vim. Any
|
||||
;; feedback after typing is better UX than no feedback at all.
|
||||
(setq echo-keystrokes 0.02)
|
||||
|
||||
;; Expand the minibuffer to fit multi-line text displayed in the echo-area. This
|
||||
;; doesn't look too great with direnv, however...
|
||||
(setq resize-mini-windows 'grow-only)
|
||||
|
||||
;; Typing yes/no is obnoxious when y/n will do
|
||||
(if EMACS28+
|
||||
(setq use-short-answers t)
|
||||
;; DEPRECATED Remove when we drop 27.x support
|
||||
(advice-add #'yes-or-no-p :override #'y-or-n-p))
|
||||
|
||||
;; Try to keep the cursor out of the read-only portions of the minibuffer.
|
||||
(setq minibuffer-prompt-properties '(read-only t intangible t cursor-intangible t face minibuffer-prompt))
|
||||
(add-hook 'minibuffer-setup-hook #'cursor-intangible-mode)
|
||||
|
||||
|
||||
;;
|
||||
;;; Built-in packages
|
||||
|
||||
;;;###package ansi-color
|
||||
(setq ansi-color-for-comint-mode t)
|
||||
|
||||
|
||||
(after! comint
|
||||
(setq comint-prompt-read-only t
|
||||
comint-buffer-maximum-size 2048)) ; double the default
|
||||
|
||||
|
||||
(after! compile
|
||||
(setq compilation-always-kill t ; kill compilation process before starting another
|
||||
compilation-ask-about-save nil ; save all buffers on `compile'
|
||||
compilation-scroll-output 'first-error)
|
||||
;; Handle ansi codes in compilation buffer
|
||||
;; DEPRECATED Use `ansi-color-compilation-filter' when dropping 27.x support
|
||||
(add-hook 'compilation-filter-hook #'doom-apply-ansi-color-to-compilation-buffer-h)
|
||||
;; Automatically truncate compilation buffers so they don't accumulate too
|
||||
;; much data and bog down the rest of Emacs.
|
||||
(autoload 'comint-truncate-buffer "comint" nil t)
|
||||
(add-hook 'compilation-filter-hook #'comint-truncate-buffer))
|
||||
|
||||
|
||||
(after! ediff
|
||||
(setq ediff-diff-options "-w" ; turn off whitespace checking
|
||||
ediff-split-window-function #'split-window-horizontally
|
||||
ediff-window-setup-function #'ediff-setup-windows-plain)
|
||||
|
||||
(defvar doom--ediff-saved-wconf nil)
|
||||
;; Restore window config after quitting ediff
|
||||
(add-hook! 'ediff-before-setup-hook
|
||||
(defun doom-ediff-save-wconf-h ()
|
||||
(setq doom--ediff-saved-wconf (current-window-configuration))))
|
||||
(add-hook! '(ediff-quit-hook ediff-suspend-hook) :append
|
||||
(defun doom-ediff-restore-wconf-h ()
|
||||
(when (window-configuration-p doom--ediff-saved-wconf)
|
||||
(set-window-configuration doom--ediff-saved-wconf)))))
|
||||
|
||||
|
||||
(use-package! hl-line
|
||||
;; Highlights the current line
|
||||
:hook (doom-first-buffer . global-hl-line-mode)
|
||||
:init
|
||||
(defvar global-hl-line-modes
|
||||
'(prog-mode text-mode conf-mode special-mode
|
||||
org-agenda-mode dired-mode)
|
||||
"What modes to enable `hl-line-mode' in.")
|
||||
:config
|
||||
;; HACK I reimplement `global-hl-line-mode' so we can white/blacklist modes in
|
||||
;; `global-hl-line-modes' _and_ so we can use `global-hl-line-mode',
|
||||
;; which users expect to control hl-line in Emacs.
|
||||
(define-globalized-minor-mode global-hl-line-mode hl-line-mode
|
||||
(lambda ()
|
||||
(and (cond (hl-line-mode nil)
|
||||
((null global-hl-line-modes) nil)
|
||||
((eq global-hl-line-modes t))
|
||||
((eq (car global-hl-line-modes) 'not)
|
||||
(not (derived-mode-p global-hl-line-modes)))
|
||||
((apply #'derived-mode-p global-hl-line-modes)))
|
||||
(hl-line-mode +1))))
|
||||
|
||||
;; Temporarily disable `hl-line' when selection is active, since it doesn't
|
||||
;; serve much purpose when the selection is so much more visible.
|
||||
(defvar doom--hl-line-mode nil)
|
||||
|
||||
(add-hook! 'hl-line-mode-hook
|
||||
(defun doom-truly-disable-hl-line-h ()
|
||||
(unless hl-line-mode
|
||||
(setq-local doom--hl-line-mode nil))))
|
||||
|
||||
(add-hook! '(evil-visual-state-entry-hook activate-mark-hook)
|
||||
(defun doom-disable-hl-line-h ()
|
||||
(when hl-line-mode
|
||||
(hl-line-mode -1)
|
||||
(setq-local doom--hl-line-mode t))))
|
||||
|
||||
(add-hook! '(evil-visual-state-exit-hook deactivate-mark-hook)
|
||||
(defun doom-enable-hl-line-maybe-h ()
|
||||
(when doom--hl-line-mode
|
||||
(hl-line-mode +1)))))
|
||||
|
||||
|
||||
(use-package! winner
|
||||
;; undo/redo changes to Emacs' window layout
|
||||
:preface (defvar winner-dont-bind-my-keys t) ; I'll bind keys myself
|
||||
:hook (doom-first-buffer . winner-mode)
|
||||
:config
|
||||
(appendq! winner-boring-buffers
|
||||
'("*Compile-Log*" "*inferior-lisp*" "*Fuzzy Completions*"
|
||||
"*Apropos*" "*Help*" "*cvs*" "*Buffer List*" "*Ibuffer*"
|
||||
"*esh command on file*")))
|
||||
|
||||
|
||||
(use-package! paren
|
||||
;; highlight matching delimiters
|
||||
:hook (doom-first-buffer . show-paren-mode)
|
||||
:config
|
||||
(setq show-paren-delay 0.1
|
||||
show-paren-highlight-openparen t
|
||||
show-paren-when-point-inside-paren t
|
||||
show-paren-when-point-in-periphery t))
|
||||
|
||||
|
||||
;;;###package whitespace
|
||||
(setq whitespace-line-column nil
|
||||
whitespace-style
|
||||
'(face indentation tabs tab-mark spaces space-mark newline newline-mark
|
||||
trailing lines-tail)
|
||||
whitespace-display-mappings
|
||||
'((tab-mark ?\t [?› ?\t])
|
||||
(newline-mark ?\n [?¬ ?\n])
|
||||
(space-mark ?\ [?·] [?.])))
|
||||
|
||||
|
||||
;;
|
||||
;;; Third party packages
|
||||
|
||||
(use-package! all-the-icons
|
||||
:commands (all-the-icons-octicon
|
||||
all-the-icons-faicon
|
||||
all-the-icons-fileicon
|
||||
all-the-icons-wicon
|
||||
all-the-icons-material
|
||||
all-the-icons-alltheicon)
|
||||
:preface
|
||||
(add-hook! 'after-setting-font-hook
|
||||
(defun doom-init-all-the-icons-fonts-h ()
|
||||
(when (fboundp 'set-fontset-font)
|
||||
(dolist (font (list "Weather Icons"
|
||||
"github-octicons"
|
||||
"FontAwesome"
|
||||
"all-the-icons"
|
||||
"file-icons"
|
||||
"Material Icons"))
|
||||
(set-fontset-font t 'unicode font nil 'append)))))
|
||||
:config
|
||||
(cond ((daemonp)
|
||||
(defadvice! doom--disable-all-the-icons-in-tty-a (fn &rest args)
|
||||
"Return a blank string in tty Emacs, which doesn't support multiple fonts."
|
||||
:around '(all-the-icons-octicon all-the-icons-material
|
||||
all-the-icons-faicon all-the-icons-fileicon
|
||||
all-the-icons-wicon all-the-icons-alltheicon)
|
||||
(if (or (not after-init-time) (display-multi-font-p))
|
||||
(apply fn args)
|
||||
"")))
|
||||
((not (display-graphic-p))
|
||||
(defadvice! doom--disable-all-the-icons-in-tty-a (&rest _)
|
||||
"Return a blank string for tty users."
|
||||
:override '(all-the-icons-octicon all-the-icons-material
|
||||
all-the-icons-faicon all-the-icons-fileicon
|
||||
all-the-icons-wicon all-the-icons-alltheicon)
|
||||
""))))
|
||||
|
||||
;; Hide the mode line in completion popups and MAN pages because they serve
|
||||
;; little purpose there, and is better hidden.
|
||||
;;;###package hide-mode-line-mode
|
||||
(add-hook! '(completion-list-mode-hook Man-mode-hook)
|
||||
#'hide-mode-line-mode)
|
||||
|
||||
;; Many major modes do no highlighting of number literals, so we do it for them
|
||||
(use-package! highlight-numbers
|
||||
:hook ((prog-mode conf-mode) . highlight-numbers-mode)
|
||||
:config (setq highlight-numbers-generic-regexp "\\_<[[:digit:]]+\\(?:\\.[0-9]*\\)?\\_>"))
|
||||
|
||||
;;;###package image
|
||||
(setq image-animate-loop t)
|
||||
|
||||
;;;###package rainbow-delimiters
|
||||
;; Helps us distinguish stacked delimiter pairs, especially in parentheses-drunk
|
||||
;; languages like Lisp. I reduce it from it's default of 9 to reduce the
|
||||
;; complexity of the font-lock keyword and hopefully buy us a few ms of
|
||||
;; performance.
|
||||
(setq rainbow-delimiters-max-face-count 4)
|
||||
|
||||
|
||||
;;
|
||||
;;; Line numbers
|
||||
|
||||
;; Explicitly define a width to reduce the cost of on-the-fly computation
|
||||
(setq-default display-line-numbers-width 3)
|
||||
|
||||
;; Show absolute line numbers for narrowed regions to make it easier to tell the
|
||||
;; buffer is narrowed, and where you are, exactly.
|
||||
(setq-default display-line-numbers-widen t)
|
||||
|
||||
;; Enable line numbers in most text-editing modes. We avoid
|
||||
;; `global-display-line-numbers-mode' because there are many special and
|
||||
;; temporary modes where we don't need/want them.
|
||||
(add-hook! '(prog-mode-hook text-mode-hook conf-mode-hook)
|
||||
#'display-line-numbers-mode)
|
||||
|
||||
;; Fix #2742: cursor is off by 4 characters in `artist-mode'
|
||||
;; REVIEW Reported upstream https://debbugs.gnu.org/cgi/bugreport.cgi?bug=43811
|
||||
;; DEPRECATED Fixed in Emacs 28; remove when we drop 27 support
|
||||
(unless EMACS28+
|
||||
(add-hook 'artist-mode-hook #'doom-disable-line-numbers-h))
|
||||
|
||||
|
||||
;;
|
||||
;;; Theme & font
|
||||
|
||||
;; User themes should live in $DOOMDIR/themes, not ~/.emacs.d
|
||||
(setq custom-theme-directory (concat doom-private-dir "themes/"))
|
||||
|
||||
;; Third party themes add themselves to `custom-theme-load-path', but the themes
|
||||
;; living in $DOOMDIR/themes should always have priority.
|
||||
(setq custom-theme-load-path
|
||||
(cons 'custom-theme-directory
|
||||
(delq 'custom-theme-directory custom-theme-load-path)))
|
||||
|
||||
(defun doom--make-font-specs (face font &optional base-specs)
|
||||
(let* ((base-specs (cadr (assq 'user (get face 'theme-face))))
|
||||
(base-specs (or base-specs '((t nil))))
|
||||
(attrs '(:family :foundry :slant :weight :height :width))
|
||||
(new-specs nil))
|
||||
(dolist (spec base-specs)
|
||||
;; Each SPEC has the form (DISPLAY ATTRIBUTE-PLIST)
|
||||
(let ((display (car spec))
|
||||
(plist (copy-tree (nth 1 spec))))
|
||||
;; Alter only DISPLAY conditions matching this frame.
|
||||
(when (or (memq display '(t default))
|
||||
(face-spec-set-match-display display this-frame))
|
||||
(dolist (attr attrs)
|
||||
(setq plist (plist-put plist attr (face-attribute face attr)))))
|
||||
(push (list display plist) new-specs)))
|
||||
(nreverse new-specs)))
|
||||
|
||||
(defun doom-init-fonts-h (&optional reload)
|
||||
"Loads `doom-font'."
|
||||
(dolist (map `((default . ,doom-font)
|
||||
(fixed-pitch . ,doom-font)
|
||||
(fixed-pitch-serif . ,doom-serif-font)
|
||||
(variable-pitch . ,doom-variable-pitch-font)))
|
||||
(when-let* ((face (car map))
|
||||
(font (cdr map)))
|
||||
(dolist (frame (frame-list))
|
||||
(when (display-multi-font-p frame)
|
||||
(set-face-attribute face frame
|
||||
:width 'normal :weight 'normal
|
||||
:slant 'normal :font font)))
|
||||
(let ((new-specs (doom--make-font-specs face font)))
|
||||
;; Don't save to `customized-face' so it's omitted from `custom-file'
|
||||
;;(put face 'customized-face new-specs)
|
||||
(custom-push-theme 'theme-face face 'user 'set new-specs)
|
||||
(put face 'face-modified nil))))
|
||||
(when (fboundp 'set-fontset-font)
|
||||
(let ((fn (doom-rpartial #'member (font-family-list))))
|
||||
(when-let (font (cl-find-if fn doom-symbol-fallback-font-families))
|
||||
(set-fontset-font t 'symbol font))
|
||||
(when-let (font (cl-find-if fn doom-emoji-fallback-font-families))
|
||||
(set-fontset-font t 'unicode font))
|
||||
(when doom-unicode-font
|
||||
(set-fontset-font t 'unicode doom-unicode-font))))
|
||||
;; Users should inject their own font logic in `after-setting-font-hook'
|
||||
(run-hooks 'after-setting-font-hook))
|
||||
|
||||
(defun doom-init-theme-h (&rest _)
|
||||
"Load the theme specified by `doom-theme' in FRAME."
|
||||
(when (and doom-theme (not (custom-theme-enabled-p doom-theme)))
|
||||
(load-theme doom-theme t)))
|
||||
|
||||
(defadvice! doom--load-theme-a (fn theme &optional no-confirm no-enable)
|
||||
"Record `doom-theme', disable old themes, and trigger `doom-load-theme-hook'."
|
||||
:around #'load-theme
|
||||
;; Run `load-theme' from an estranged buffer, where we can ensure that
|
||||
;; buffer-local face remaps (by `mixed-pitch-mode', for instance) won't
|
||||
;; interfere with recalculating faces in new themes.
|
||||
(with-temp-buffer
|
||||
(let ((last-themes (copy-sequence custom-enabled-themes)))
|
||||
;; Disable previous themes so there are no conflicts. If you truly want
|
||||
;; multiple themes enabled, then use `enable-theme' instead.
|
||||
(mapc #'disable-theme custom-enabled-themes)
|
||||
(prog1 (funcall fn theme no-confirm no-enable)
|
||||
(when (and (not no-enable) (custom-theme-enabled-p theme))
|
||||
(setq doom-theme theme)
|
||||
(put 'doom-theme 'previous-themes (or last-themes 'none))
|
||||
;; DEPRECATED Hook into `enable-theme-functions' when we target 29
|
||||
(doom-run-hooks 'doom-load-theme-hook))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Bootstrap
|
||||
|
||||
(defun doom-init-ui-h (&optional _)
|
||||
"Initialize Doom's user interface by applying all its advice and hooks.
|
||||
|
||||
These should be done as late as possible, as to avoid/minimize prematurely
|
||||
triggering hooks during startup."
|
||||
(doom-run-hooks 'doom-init-ui-hook)
|
||||
|
||||
(add-hook 'kill-buffer-query-functions #'doom-protect-fallback-buffer-h)
|
||||
(add-hook 'after-change-major-mode-hook #'doom-highlight-non-default-indentation-h 'append)
|
||||
|
||||
;; Initialize `doom-switch-window-hook' and `doom-switch-frame-hook'
|
||||
(add-hook 'window-selection-change-functions #'doom-run-switch-window-or-frame-hooks-h)
|
||||
;; Initialize `doom-switch-buffer-hook'
|
||||
(add-hook 'window-buffer-change-functions #'doom-run-switch-buffer-hooks-h)
|
||||
;; `window-buffer-change-functions' doesn't trigger for files visited via the server.
|
||||
(add-hook 'server-visit-hook #'doom-run-switch-buffer-hooks-h)
|
||||
|
||||
;; Only execute this function once.
|
||||
(remove-hook 'window-buffer-change-functions #'doom-init-ui-h))
|
||||
|
||||
;; Apply fonts and theme
|
||||
(let ((hook (if (daemonp)
|
||||
'server-after-make-frame-hook
|
||||
'after-init-hook)))
|
||||
(add-hook hook #'doom-init-fonts-h -100)
|
||||
(add-hook hook #'doom-init-theme-h -90))
|
||||
|
||||
;; Initialize UI as late as possible. `window-buffer-change-functions' runs
|
||||
;; once, when the scratch/dashboard buffer is first displayed.
|
||||
(add-hook 'window-buffer-change-functions #'doom-init-ui-h -100)
|
||||
|
||||
|
||||
;;
|
||||
;;; Fixes/hacks
|
||||
|
||||
;; Doom doesn't support `customize' and it never will. It's a clumsy interface
|
||||
;; that sets variables at a time where it can be easily and unpredictably
|
||||
;; overwritten. Configure things from your $DOOMDIR instead.
|
||||
(dolist (sym '(customize-option customize-browse customize-group customize-face
|
||||
customize-rogue customize-saved customize-apropos
|
||||
customize-changed customize-unsaved customize-variable
|
||||
customize-set-value customize-customized customize-set-variable
|
||||
customize-apropos-faces customize-save-variable
|
||||
customize-apropos-groups customize-apropos-options
|
||||
customize-changed-options customize-save-customized))
|
||||
(put sym 'disabled "Doom doesn't support `customize', configure Emacs from $DOOMDIR/config.el instead"))
|
||||
(put 'customize-themes 'disabled "Set `doom-theme' or use `load-theme' in $DOOMDIR/config.el instead")
|
||||
|
||||
;; Doesn't exist in terminal Emacs, but some Emacs packages (internal and
|
||||
;; external) use it anyway, leading to a void-function error, so define a no-op
|
||||
;; substitute to suppress them.
|
||||
(unless (fboundp 'define-fringe-bitmap)
|
||||
(fset 'define-fringe-bitmap #'ignore))
|
||||
|
||||
(after! whitespace
|
||||
(defun doom-is-childframes-p ()
|
||||
"`whitespace-mode' inundates child frames with whitespace markers, so
|
||||
disable it to fix all that visual noise."
|
||||
(null (frame-parameter nil 'parent-frame)))
|
||||
(add-function :before-while whitespace-enable-predicate #'doom-is-childframes-p))
|
||||
|
||||
(provide 'doom-ui)
|
||||
;;; doom-ui.el ends here
|
||||
518
lisp/doom.el
Normal file
518
lisp/doom.el
Normal file
|
|
@ -0,0 +1,518 @@
|
|||
;;; doom.el --- the heart of the beast -*- lexical-binding: t; -*-
|
||||
;;
|
||||
;; Author: Henrik Lissner <contact@henrik.io>
|
||||
;; URL: https://github.com/doomemacs/doomemacs
|
||||
;;
|
||||
;; ================= =============== =============== ======== ========
|
||||
;; \\ . . . . . . .\\ //. . . . . . .\\ //. . . . . . .\\ \\. . .\\// . . //
|
||||
;; ||. . ._____. . .|| ||. . ._____. . .|| ||. . ._____. . .|| || . . .\/ . . .||
|
||||
;; || . .|| ||. . || || . .|| ||. . || || . .|| ||. . || ||. . . . . . . ||
|
||||
;; ||. . || || . .|| ||. . || || . .|| ||. . || || . .|| || . | . . . . .||
|
||||
;; || . .|| ||. _-|| ||-_ .|| ||. . || || . .|| ||. _-|| ||-_.|\ . . . . ||
|
||||
;; ||. . || ||-' || || `-|| || . .|| ||. . || ||-' || || `|\_ . .|. .||
|
||||
;; || . _|| || || || || ||_ . || || . _|| || || || |\ `-_/| . ||
|
||||
;; ||_-' || .|/ || || \|. || `-_|| ||_-' || .|/ || || | \ / |-_.||
|
||||
;; || ||_-' || || `-_|| || || ||_-' || || | \ / | `||
|
||||
;; || `' || || `' || || `' || || | \ / | ||
|
||||
;; || .===' `===. .==='.`===. .===' /==. | \/ | ||
|
||||
;; || .==' \_|-_ `===. .===' _|_ `===. .===' _-|/ `== \/ | ||
|
||||
;; || .==' _-' `-_ `=' _-' `-_ `=' _-' `-_ /| \/ | ||
|
||||
;; || .==' _-' '-__\._-' '-_./__-' `' |. /| | ||
|
||||
;; ||.==' _-' `' | /==.||
|
||||
;; ==' _-' \/ `==
|
||||
;; \ _-' `-_ /
|
||||
;; `'' ``'
|
||||
;;
|
||||
;; These demons are not part of GNU Emacs.
|
||||
;;
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This is Doom's heart, where I define all its major constants and variables,
|
||||
;; set its saner global defaults, then prepare Emacs to bootstrap Doom.
|
||||
;;
|
||||
;; The overall load order of Doom is as follows:
|
||||
;;
|
||||
;; $EMACSDIR/early-init.el
|
||||
;; $EMACSDIR/lisp/doom.el
|
||||
;; $EMACSDIR/lisp/doom-start.el
|
||||
;; $DOOMDIR/init.el
|
||||
;; {$DOOMDIR,~/.emacs.d}/modules/*/*/init.el
|
||||
;; `doom-before-init-modules-hook'
|
||||
;; {$DOOMDIR,~/.emacs.d}/modules/*/*/config.el
|
||||
;; `doom-init-modules-hook'
|
||||
;; $DOOMDIR/config.el
|
||||
;; `doom-after-init-modules-hook'
|
||||
;; `after-init-hook'
|
||||
;; `emacs-startup-hook'
|
||||
;; `doom-init-ui-hook'
|
||||
;; `window-setup-hook'
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(when (< emacs-major-version 27)
|
||||
(error "Detected Emacs %s. Minimum supported version is 27.1."
|
||||
emacs-version))
|
||||
|
||||
;; Remember these variables' initial values, so we can safely reset them at a
|
||||
;; later time, or consult them without fear of contamination.
|
||||
(dolist (var '(exec-path load-path process-environment))
|
||||
(unless (get var 'initial-value)
|
||||
(put var 'initial-value (default-value var))))
|
||||
|
||||
;; Prevent unwanted runtime compilation for gccemacs (native-comp) users;
|
||||
;; packages are compiled ahead-of-time when they are installed and site files
|
||||
;; are compiled when gccemacs is installed.
|
||||
(setq native-comp-deferred-compilation nil)
|
||||
|
||||
;; Since Emacs 27, package initialization occurs before `user-init-file' is
|
||||
;; loaded, but after `early-init-file'. Doom handles package initialization, so
|
||||
;; we must prevent Emacs from doing it again.
|
||||
(setq package-enable-at-startup nil)
|
||||
|
||||
;; Just the... bear necessities~
|
||||
(require 'cl-lib)
|
||||
(require 'subr-x)
|
||||
|
||||
|
||||
;;
|
||||
;;; Global constants
|
||||
|
||||
;; Emacs features
|
||||
(defconst EMACS28+ (> emacs-major-version 27))
|
||||
(defconst EMACS29+ (> emacs-major-version 28))
|
||||
(defconst MODULES (bound-and-true-p module-file-suffix))
|
||||
(defconst NATIVECOMP (if (fboundp 'native-comp-available-p) (native-comp-available-p)))
|
||||
|
||||
;; Operating system
|
||||
(defconst IS-MAC (eq system-type 'darwin))
|
||||
(defconst IS-LINUX (eq system-type 'gnu/linux))
|
||||
(defconst IS-WINDOWS (memq system-type '(cygwin windows-nt ms-dos)))
|
||||
(defconst IS-BSD (or IS-MAC (eq system-type 'berkeley-unix)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Cross-platform fixes
|
||||
|
||||
(when IS-WINDOWS
|
||||
(when-let (realhome
|
||||
;; Fix HOME on Windows, where it's not normally defined (though
|
||||
;; many unix tools expect it).
|
||||
(and (null (getenv-internal "HOME"))
|
||||
(getenv "USERPROFILE")))
|
||||
(setenv "HOME" realhome)
|
||||
(setq abbreviated-home-dir nil)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Core variables
|
||||
|
||||
(defgroup doom nil
|
||||
"An Emacs framework for the stubborn martian hacker."
|
||||
:link '(url-link "https://doomemacs.org"))
|
||||
|
||||
(defconst doom-version "3.0.0-dev"
|
||||
"Current version of Doom Emacs core.")
|
||||
|
||||
(defconst doom-modules-version "22.07.0-dev"
|
||||
"Current version of Doom Emacs.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Directory variables
|
||||
|
||||
(defconst doom-emacs-dir user-emacs-directory
|
||||
"The path to the currently loaded .emacs.d directory. Must end with a slash.")
|
||||
|
||||
(defconst doom-core-dir (expand-file-name "lisp/" doom-emacs-dir)
|
||||
"The root directory of Doom's core files. Must end with a slash.")
|
||||
|
||||
(defconst doom-modules-dir (expand-file-name "modules/" doom-emacs-dir)
|
||||
"The root directory for Doom's modules. Must end with a slash.")
|
||||
|
||||
(defconst doom-docs-dir (concat doom-emacs-dir "docs/")
|
||||
"Where Doom's documentation files are stored. Must end with a slash.")
|
||||
|
||||
(defconst doom-private-dir
|
||||
(if-let (doomdir (getenv-internal "DOOMDIR"))
|
||||
(expand-file-name (file-name-as-directory doomdir))
|
||||
(or (let ((xdgdir
|
||||
(expand-file-name "doom/"
|
||||
(or (getenv-internal "XDG_CONFIG_HOME")
|
||||
"~/.config"))))
|
||||
(if (file-directory-p xdgdir) xdgdir))
|
||||
"~/.doom.d/"))
|
||||
"Where your private configuration is placed.
|
||||
|
||||
Defaults to ~/.config/doom, ~/.doom.d or the value of the DOOMDIR envvar;
|
||||
whichever is found first. Must end in a slash.")
|
||||
|
||||
(defconst doom-profile
|
||||
(if-let (profile (getenv-internal "DOOMPROFILE"))
|
||||
;; DEPRECATED Use `string-search' once 27 support is dropped
|
||||
(if (string-match-p "@" profile)
|
||||
profile
|
||||
(concat profile "@latest"))
|
||||
;; TODO Restore this when profile system is complete
|
||||
;; "default@latest"
|
||||
)
|
||||
"The name of the active profile.")
|
||||
|
||||
;; TODO Use me
|
||||
(defconst doom-profiles-file
|
||||
(expand-file-name "profiles.el" user-emacs-directory)
|
||||
"TODO")
|
||||
|
||||
(defconst doom-profiles-dir
|
||||
(if-let (profilesdir (getenv-internal "DOOMPROFILESDIR"))
|
||||
(expand-file-name "./" profilesdir)
|
||||
(expand-file-name "profiles/" doom-emacs-dir))
|
||||
"Where Doom stores its profiles.
|
||||
|
||||
Profiles are essentially snapshots of Doom Emacs environments. Every time you
|
||||
update or sync, you create a new generation of a profile (which can be easily
|
||||
rolled back or switched between with the DOOMPROFILE envvar). Must end in a
|
||||
slash.")
|
||||
|
||||
(defconst doom-profile-dir
|
||||
(expand-file-name (concat (or doom-profile "default@latest") "/")
|
||||
doom-profiles-dir)
|
||||
"The path to the current, active profile.
|
||||
|
||||
Must end in a slash.")
|
||||
|
||||
(defconst doom-profile-data-dir
|
||||
(expand-file-name "data/" doom-profile-dir)
|
||||
"Where file storage/servers for the current, active profile is kept.
|
||||
|
||||
Use this for long-living files that contain shared data that the user would
|
||||
reasonably want to keep, and/or are required for Emacs to function correctly.
|
||||
Must end in a slash.")
|
||||
|
||||
(defconst doom-profile-cache-dir
|
||||
(expand-file-name "cache/" doom-profile-dir)
|
||||
"Where file caches for the current, active profile is kept.
|
||||
|
||||
Use this for non-essential data files that, when deleted, won't cause breakage
|
||||
or misbehavior, and can be restored. This includes server binaries or programs
|
||||
downloaded/installed by packages. Must end in a slash.")
|
||||
|
||||
(defconst doom-profile-init-file
|
||||
(expand-file-name "init.el" doom-profile-dir)
|
||||
"TODO")
|
||||
|
||||
|
||||
;;
|
||||
;;; DEPRECATED file/directory vars
|
||||
|
||||
(defconst doom-local-dir
|
||||
(if-let (localdir (getenv-internal "DOOMLOCALDIR"))
|
||||
(expand-file-name (file-name-as-directory localdir))
|
||||
(if doom-profile
|
||||
doom-profile-dir
|
||||
(expand-file-name ".local/" doom-emacs-dir)))
|
||||
"Root directory for local storage.
|
||||
|
||||
Use this as a storage location for this system's installation of Doom Emacs.
|
||||
|
||||
These files should not be shared across systems. By default, it is used by
|
||||
`doom-etc-dir' and `doom-cache-dir'. Must end with a slash.")
|
||||
|
||||
(defconst doom-etc-dir
|
||||
(if doom-profile
|
||||
doom-profile-data-dir
|
||||
(concat doom-local-dir "etc/"))
|
||||
"Directory for non-volatile local storage.
|
||||
|
||||
Use this for files that don't change much, like server binaries, external
|
||||
dependencies or long-term shared data. Must end with a slash.")
|
||||
|
||||
(defconst doom-cache-dir
|
||||
(if doom-profile
|
||||
doom-profile-cache-dir
|
||||
(concat doom-local-dir "cache/"))
|
||||
"Directory for volatile local storage.
|
||||
|
||||
Use this for files that change often, like cache files. Must end with a slash.")
|
||||
|
||||
(defconst doom-autoloads-file
|
||||
(if doom-profile
|
||||
doom-profile-init-file
|
||||
(concat doom-local-dir "autoloads." emacs-version ".el"))
|
||||
"Where `doom-reload-core-autoloads' stores its core autoloads.
|
||||
|
||||
This file is responsible for informing Emacs where to find all of Doom's
|
||||
autoloaded core functions (in lisp/lib/*.el).")
|
||||
|
||||
(defconst doom-env-file
|
||||
(if doom-profile
|
||||
(expand-file-name "env" doom-profile-dir)
|
||||
(concat doom-local-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).")
|
||||
|
||||
|
||||
;;
|
||||
;;; Custom error types
|
||||
|
||||
(define-error 'doom-error "Error in Doom Emacs core")
|
||||
(define-error 'doom-hook-error "Error in a Doom startup hook" 'doom-error)
|
||||
(define-error 'doom-autoload-error "Error in Doom's autoloads file" 'doom-error)
|
||||
(define-error 'doom-module-error "Error in a Doom module" 'doom-error)
|
||||
(define-error 'doom-private-error "Error in private config" 'doom-error)
|
||||
(define-error 'doom-package-error "Error with packages" 'doom-error)
|
||||
|
||||
|
||||
;;
|
||||
;;; Custom hooks
|
||||
|
||||
(defvar doom-first-input-hook nil
|
||||
"Transient hooks run before the first user input.")
|
||||
(put 'doom-first-input-hook 'permanent-local t)
|
||||
|
||||
(defvar doom-first-file-hook nil
|
||||
"Transient hooks run before the first interactively opened file.")
|
||||
(put 'doom-first-file-hook 'permanent-local t)
|
||||
|
||||
(defvar doom-first-buffer-hook nil
|
||||
"Transient hooks run before the first interactively opened buffer.")
|
||||
(put 'doom-first-buffer-hook 'permanent-local t)
|
||||
|
||||
(defvar doom-after-reload-hook nil
|
||||
"A list of hooks to run after `doom/reload' has reloaded Doom.")
|
||||
|
||||
(defvar doom-before-reload-hook nil
|
||||
"A list of hooks to run before `doom/reload' has reloaded Doom.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Native Compilation support (http://akrl.sdf.org/gccemacs.html)
|
||||
|
||||
(when NATIVECOMP
|
||||
;; Don't store eln files in ~/.emacs.d/eln-cache (where they can easily be
|
||||
;; deleted by 'doom upgrade').
|
||||
(add-to-list 'native-comp-eln-load-path (concat doom-cache-dir "eln/"))
|
||||
|
||||
(with-eval-after-load 'comp
|
||||
;; HACK Disable native-compilation for some troublesome packages
|
||||
(mapc (apply-partially #'add-to-list 'native-comp-deferred-compilation-deny-list)
|
||||
(let ((local-dir-re (concat "\\`" (regexp-quote doom-local-dir))))
|
||||
(list (concat local-dir-re ".*/emacs-jupyter.*\\.el\\'")
|
||||
(concat local-dir-re ".*/evil-collection-vterm\\.el\\'")
|
||||
(concat local-dir-re ".*/with-editor\\.el\\'"))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Don't litter `doom-emacs-dir'/$HOME
|
||||
|
||||
;; I change `user-emacs-directory' because many packages (even built-in ones)
|
||||
;; abuse it to build paths for storage/cache files (instead of correctly using
|
||||
;; `locate-user-emacs-file'). This change ensures that said data files are never
|
||||
;; saved to the root of your emacs directory *and* saves us the trouble setting
|
||||
;; a million directory/file variables.
|
||||
(setq user-emacs-directory doom-cache-dir)
|
||||
|
||||
;; ...However, this may surprise packages (and users) that read
|
||||
;; `user-emacs-directory' expecting to find the location of your Emacs config,
|
||||
;; such as server.el!
|
||||
(setq server-auth-dir (expand-file-name "server/" doom-emacs-dir))
|
||||
|
||||
;; Packages with file/dir settings that don't use `user-emacs-directory' or
|
||||
;; `locate-user-emacs-file' to initialize will need to set explicitly, to stop
|
||||
;; them from littering in ~/.emacs.d/.
|
||||
(setq desktop-dirname (expand-file-name "desktop" doom-cache-dir)
|
||||
pcache-directory (expand-file-name "pcache/" doom-cache-dir))
|
||||
|
||||
;; Allow the user to store custom.el-saved settings and themes in their Doom
|
||||
;; config (e.g. ~/.doom.d/).
|
||||
(setq custom-file (expand-file-name "custom.el" doom-private-dir))
|
||||
|
||||
;; By default, Emacs stores `authinfo' in $HOME and in plain-text. Let's not do
|
||||
;; that, mkay? This file stores usernames, passwords, and other treasures for
|
||||
;; the aspiring malicious third party. You'll need a GPG setup though.
|
||||
(setq auth-sources (list (concat doom-etc-dir "authinfo.gpg")
|
||||
"~/.authinfo.gpg"))
|
||||
|
||||
(define-advice en/disable-command (:around (fn &rest args) write-to-data-dir)
|
||||
"Write saved safe-local-variables to `custom-file' instead.
|
||||
|
||||
Otherwise, `en/disable-command' (in novice.el.gz) is hardcoded to write them to
|
||||
`user-init-file')."
|
||||
(let ((user-init-file custom-file))
|
||||
(apply fn args)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Bootstrap
|
||||
|
||||
;; Ensure Doom's core libraries are visible for loading
|
||||
(add-to-list 'load-path doom-core-dir)
|
||||
|
||||
;; ...then load *the* one
|
||||
(require 'doom-lib)
|
||||
|
||||
|
||||
;;
|
||||
;;; Runtime/startup optimizations
|
||||
|
||||
;; A second, case-insensitive pass over `auto-mode-alist' is time wasted and
|
||||
;; indicates misconfiguration.
|
||||
(setq auto-mode-case-fold nil)
|
||||
|
||||
;; Disable bidirectional text scanning for a modest performance boost. I've set
|
||||
;; this to `nil' in the past, but the `bidi-display-reordering's docs say that
|
||||
;; is an undefined state and suggest this to be just as good:
|
||||
(setq-default bidi-display-reordering 'left-to-right
|
||||
bidi-paragraph-direction 'left-to-right)
|
||||
|
||||
;; Disabling the BPA makes redisplay faster, but might produce incorrect display
|
||||
;; reordering of bidirectional text with embedded parentheses and other bracket
|
||||
;; characters whose 'paired-bracket' Unicode property is non-nil.
|
||||
(setq bidi-inhibit-bpa t) ; Emacs 27 only
|
||||
|
||||
;; Reduce rendering/line scan work for Emacs by not rendering cursors or regions
|
||||
;; in non-focused windows.
|
||||
(setq-default cursor-in-non-selected-windows nil)
|
||||
(setq highlight-nonselected-windows nil)
|
||||
|
||||
;; More performant rapid scrolling over unfontified regions. May cause brief
|
||||
;; spells of inaccurate syntax highlighting right after scrolling, which should
|
||||
;; quickly self-correct.
|
||||
(setq fast-but-imprecise-scrolling t)
|
||||
|
||||
;; Don't ping things that look like domain names.
|
||||
(setq ffap-machine-p-known 'reject)
|
||||
|
||||
;; Resizing the Emacs frame can be a terribly expensive part of changing the
|
||||
;; font. By inhibiting this, we halve startup times, particularly when we use
|
||||
;; fonts that are larger than the system default (which would resize the frame).
|
||||
(setq frame-inhibit-implied-resize t)
|
||||
|
||||
;; The GC introduces annoying pauses and stuttering into our Emacs experience,
|
||||
;; so we use `gcmh' to stave off the GC while we're using Emacs, and provoke it
|
||||
;; when it's idle. However, if the idle delay is too long, we run the risk of
|
||||
;; runaway memory usage in busy sessions. If it's too low, then we may as well
|
||||
;; not be using gcmh at all.
|
||||
(setq gcmh-idle-delay 'auto ; default is 15s
|
||||
gcmh-auto-idle-delay-factor 10
|
||||
gcmh-high-cons-threshold (* 16 1024 1024)) ; 16mb
|
||||
|
||||
;; Emacs "updates" its ui more often than it needs to, so slow it down slightly
|
||||
(setq idle-update-delay 1.0) ; default is 0.5
|
||||
|
||||
;; Font compacting can be terribly expensive, especially for rendering icon
|
||||
;; fonts on Windows. Whether disabling it has a notable affect on Linux and Mac
|
||||
;; hasn't been determined, but do it anyway, just in case. This increases memory
|
||||
;; usage, however!
|
||||
(setq inhibit-compacting-font-caches t)
|
||||
|
||||
;; PGTK builds only: this timeout adds latency to frame operations, like
|
||||
;; `make-frame-invisible', which are frequently called without a guard because
|
||||
;; it's inexpensive in non-PGTK builds. Lowering the timeout from the default
|
||||
;; 0.1 should make childframes and packages that manipulate them (like `lsp-ui',
|
||||
;; `company-box', and `posframe') feel much snappier. See emacs-lsp/lsp-ui#613.
|
||||
(setq pgtk-wait-for-event-timeout 0.001)
|
||||
|
||||
;; Increase how much is read from processes in a single chunk (default is 4kb).
|
||||
;; This is further increased elsewhere, where needed (like our LSP module).
|
||||
(setq read-process-output-max (* 64 1024)) ; 64kb
|
||||
|
||||
;; Introduced in Emacs HEAD (b2f8c9f), this inhibits fontification while
|
||||
;; receiving input, which should help a little with scrolling performance.
|
||||
(setq redisplay-skip-fontification-on-input t)
|
||||
|
||||
;; Performance on Windows is considerably worse than elsewhere. We'll need
|
||||
;; everything we can get.
|
||||
(when (boundp 'w32-get-true-file-attributes)
|
||||
(setq w32-get-true-file-attributes nil ; decrease file IO workload
|
||||
w32-pipe-read-delay 0 ; faster IPC
|
||||
w32-pipe-buffer-size (* 64 1024))) ; read more at a time (was 4K)
|
||||
|
||||
;; Remove command line options that aren't relevant to our current OS; means
|
||||
;; slightly less to process at startup.
|
||||
(unless IS-MAC (setq command-line-ns-option-alist nil))
|
||||
(unless IS-LINUX (setq command-line-x-option-alist nil))
|
||||
|
||||
;; HACK `tty-run-terminal-initialization' is *tremendously* slow for some
|
||||
;; reason; inexplicably doubling startup time for terminal Emacs. Keeping
|
||||
;; it disabled will have nasty side-effects, so we simply delay it instead,
|
||||
;; and invoke it later, at which point it runs quickly; how mysterious!
|
||||
(unless (or (daemonp) init-file-debug)
|
||||
(advice-add #'tty-run-terminal-initialization :override #'ignore)
|
||||
(add-hook! 'window-setup-hook
|
||||
(defun doom-init-tty-h ()
|
||||
(advice-remove #'tty-run-terminal-initialization #'ignore)
|
||||
(tty-run-terminal-initialization (selected-frame) nil t))))
|
||||
|
||||
;; Shave seconds off startup time by starting the scratch buffer in
|
||||
;; `fundamental-mode', rather than, say, `org-mode' or `text-mode', which pull
|
||||
;; in a ton of packages. `doom/open-scratch-buffer' provides a better scratch
|
||||
;; buffer anyway.
|
||||
(setq initial-major-mode 'fundamental-mode
|
||||
initial-scratch-message nil)
|
||||
|
||||
|
||||
;;
|
||||
;;; Reasonable, global defaults
|
||||
|
||||
;; Contrary to what many Emacs users have in their configs, you don't need more
|
||||
;; than this to make UTF-8 the default coding system:
|
||||
(set-language-environment "UTF-8")
|
||||
;; ...but `set-language-environment' also sets `default-input-method', which is
|
||||
;; a step too opinionated.
|
||||
(setq default-input-method nil)
|
||||
;; ...And the clipboard on Windows could be in a wider encoding (UTF-16), so
|
||||
;; leave Emacs to its own devices.
|
||||
(unless IS-WINDOWS
|
||||
(setq selection-coding-system 'utf-8))
|
||||
|
||||
;; Disable warnings from the legacy advice API. They aren't actionable or
|
||||
;; useful, and often come from third party packages.
|
||||
(setq ad-redefinition-action 'accept)
|
||||
|
||||
;; Reduce debug output unless we've asked for it.
|
||||
(setq debug-on-error init-file-debug
|
||||
jka-compr-verbose init-file-debug)
|
||||
|
||||
;; Get rid of "For information about GNU Emacs..." message at startup. It's
|
||||
;; redundant with our dashboard. However, in daemon sessions it says "Starting
|
||||
;; Emacs daemon." instead, which is fine.
|
||||
(unless (daemonp)
|
||||
(advice-add #'display-startup-echo-area-message :override #'ignore))
|
||||
|
||||
;; Reduce *Message* noise at startup. An empty scratch buffer (or the dashboard)
|
||||
;; is more than enough.
|
||||
(setq inhibit-startup-screen t
|
||||
inhibit-startup-echo-area-message user-login-name
|
||||
inhibit-default-init t)
|
||||
|
||||
;; Emacs is essentially one huge security vulnerability, what with all the
|
||||
;; dependencies it pulls in from all corners of the globe. Let's try to be a
|
||||
;; *little* more discerning.
|
||||
(setq gnutls-verify-error noninteractive
|
||||
gnutls-algorithm-priority
|
||||
(when (boundp 'libgnutls-version)
|
||||
(concat "SECURE128:+SECURE192:-VERS-ALL"
|
||||
(if (and (not IS-WINDOWS)
|
||||
(>= libgnutls-version 30605))
|
||||
":+VERS-TLS1.3")
|
||||
":+VERS-TLS1.2"))
|
||||
;; `gnutls-min-prime-bits' is set based on recommendations from
|
||||
;; https://www.keylength.com/en/4/
|
||||
gnutls-min-prime-bits 3072
|
||||
tls-checktrust gnutls-verify-error
|
||||
;; Emacs is built with gnutls.el by default, so `tls-program' won't
|
||||
;; typically be used, but in the odd case that it does, we ensure a more
|
||||
;; secure default for it (falling back to `openssl' if absolutely
|
||||
;; necessary). See https://redd.it/8sykl1 for details.
|
||||
tls-program '("openssl s_client -connect %h:%p -CAfile %t -nbio -no_ssl3 -no_tls1 -no_tls1_1 -ign_eof"
|
||||
"gnutls-cli -p %p --dh-bits=3072 --ocsp --x509cafile=%t \
|
||||
--strict-tofu --priority='SECURE192:+SECURE128:-VERS-ALL:+VERS-TLS1.2:+VERS-TLS1.3' %h"
|
||||
;; compatibility fallbacks
|
||||
"gnutls-cli -p %p %h"))
|
||||
|
||||
(provide 'doom)
|
||||
;;; doom.el ends here
|
||||
393
lisp/lib/buffers.el
Normal file
393
lisp/lib/buffers.el
Normal file
|
|
@ -0,0 +1,393 @@
|
|||
;;; lisp/lib/buffers.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-real-buffer-functions
|
||||
'(doom-dired-buffer-p)
|
||||
"A list of predicate functions run to determine if a buffer is real, unlike
|
||||
`doom-unreal-buffer-functions'. They are passed one argument: the buffer to be
|
||||
tested.
|
||||
|
||||
Should any of its function returns non-nil, the rest of the functions are
|
||||
ignored and the buffer is considered real.
|
||||
|
||||
See `doom-real-buffer-p' for more information.")
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-unreal-buffer-functions
|
||||
'(minibufferp doom-special-buffer-p doom-non-file-visiting-buffer-p)
|
||||
"A list of predicate functions run to determine if a buffer is *not* real,
|
||||
unlike `doom-real-buffer-functions'. They are passed one argument: the buffer to
|
||||
be tested.
|
||||
|
||||
Should any of these functions return non-nil, the rest of the functions are
|
||||
ignored and the buffer is considered unreal.
|
||||
|
||||
See `doom-real-buffer-p' for more information.")
|
||||
|
||||
;;;###autoload
|
||||
(defvar-local doom-real-buffer-p nil
|
||||
"If non-nil, this buffer should be considered real no matter what. See
|
||||
`doom-real-buffer-p' for more information.")
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-fallback-buffer-name "*scratch*"
|
||||
"The name of the buffer to fall back to if no other buffers exist (will create
|
||||
it if it doesn't exist).")
|
||||
|
||||
|
||||
;;
|
||||
;;; Functions
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-buffer-frame-predicate (buf)
|
||||
"To be used as the default frame buffer-predicate parameter. Returns nil if
|
||||
BUF should be skipped over by functions like `next-buffer' and `other-buffer'."
|
||||
(or (doom-real-buffer-p buf)
|
||||
(eq buf (doom-fallback-buffer))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-fallback-buffer ()
|
||||
"Returns the fallback buffer, creating it if necessary. By default this is the
|
||||
scratch buffer. See `doom-fallback-buffer-name' to change this."
|
||||
(let (buffer-list-update-hook)
|
||||
(get-buffer-create doom-fallback-buffer-name)))
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'doom-buffer-list #'buffer-list)
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-project-buffer-list (&optional project)
|
||||
"Return a list of buffers belonging to the specified PROJECT.
|
||||
|
||||
If PROJECT is nil, default to the current project.
|
||||
|
||||
If no project is active, return all buffers."
|
||||
(let ((buffers (doom-buffer-list)))
|
||||
(if-let* ((project-root
|
||||
(if project (expand-file-name project)
|
||||
(doom-project-root))))
|
||||
(cl-loop for buf in buffers
|
||||
if (projectile-project-buffer-p buf project-root)
|
||||
collect buf)
|
||||
buffers)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-open-projects ()
|
||||
"Return a list of projects with open buffers."
|
||||
(cl-loop with projects = (make-hash-table :test 'equal :size 8)
|
||||
for buffer in (doom-buffer-list)
|
||||
if (buffer-live-p buffer)
|
||||
if (doom-real-buffer-p buffer)
|
||||
if (with-current-buffer buffer (doom-project-root))
|
||||
do (puthash (abbreviate-file-name it) t projects)
|
||||
finally return (hash-table-keys projects)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-dired-buffer-p (buf)
|
||||
"Returns non-nil if BUF is a dired buffer."
|
||||
(provided-mode-derived-p (buffer-local-value 'major-mode buf)
|
||||
'dired-mode))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-special-buffer-p (buf)
|
||||
"Returns non-nil if BUF's name starts and ends with an *."
|
||||
(equal (substring (buffer-name buf) 0 1) "*"))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-temp-buffer-p (buf)
|
||||
"Returns non-nil if BUF is temporary."
|
||||
(equal (substring (buffer-name buf) 0 1) " "))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-visible-buffer-p (buf)
|
||||
"Return non-nil if BUF is visible."
|
||||
(get-buffer-window buf))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-buried-buffer-p (buf)
|
||||
"Return non-nil if BUF is not visible."
|
||||
(not (doom-visible-buffer-p buf)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-non-file-visiting-buffer-p (buf)
|
||||
"Returns non-nil if BUF does not have a value for `buffer-file-name'."
|
||||
(not (buffer-file-name buf)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-real-buffer-list (&optional buffer-list)
|
||||
"Return a list of buffers that satisfy `doom-real-buffer-p'."
|
||||
(cl-remove-if-not #'doom-real-buffer-p (or buffer-list (doom-buffer-list))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-real-buffer-p (buffer-or-name)
|
||||
"Returns t if BUFFER-OR-NAME is a 'real' buffer.
|
||||
|
||||
A real buffer is a useful buffer; a first class citizen in Doom. Real ones
|
||||
should get special treatment, because we will be spending most of our time in
|
||||
them. Unreal ones should be low-profile and easy to cast aside, so we can focus
|
||||
on real ones.
|
||||
|
||||
The exact criteria for a real buffer is:
|
||||
|
||||
1. A non-nil value for the buffer-local value of the `doom-real-buffer-p'
|
||||
variable OR
|
||||
2. Any function in `doom-real-buffer-functions' returns non-nil OR
|
||||
3. None of the functions in `doom-unreal-buffer-functions' must return
|
||||
non-nil.
|
||||
|
||||
If BUFFER-OR-NAME is omitted or nil, the current buffer is tested."
|
||||
(or (bufferp buffer-or-name)
|
||||
(stringp buffer-or-name)
|
||||
(signal 'wrong-type-argument (list '(bufferp stringp) buffer-or-name)))
|
||||
(when-let (buf (get-buffer buffer-or-name))
|
||||
(when-let (basebuf (buffer-base-buffer buf))
|
||||
(setq buf basebuf))
|
||||
(and (buffer-live-p buf)
|
||||
(not (doom-temp-buffer-p buf))
|
||||
(or (buffer-local-value 'doom-real-buffer-p buf)
|
||||
(run-hook-with-args-until-success 'doom-real-buffer-functions buf)
|
||||
(not (run-hook-with-args-until-success 'doom-unreal-buffer-functions buf))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-unreal-buffer-p (buffer-or-name)
|
||||
"Return t if BUFFER-OR-NAME is an 'unreal' buffer.
|
||||
|
||||
See `doom-real-buffer-p' for details on what that means."
|
||||
(not (doom-real-buffer-p buffer-or-name)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-buffers-in-mode (modes &optional buffer-list derived-p)
|
||||
"Return a list of buffers whose `major-mode' is `eq' to MODE(S).
|
||||
|
||||
If DERIVED-P, test with `derived-mode-p', otherwise use `eq'."
|
||||
(let ((modes (doom-enlist modes)))
|
||||
(cl-remove-if-not (if derived-p
|
||||
(lambda (buf)
|
||||
(apply #'provided-mode-derived-p
|
||||
(buffer-local-value 'major-mode buf)
|
||||
modes))
|
||||
(lambda (buf)
|
||||
(memq (buffer-local-value 'major-mode buf) modes)))
|
||||
(or buffer-list (doom-buffer-list)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-visible-windows (&optional window-list)
|
||||
"Return a list of the visible, non-popup (dedicated) windows."
|
||||
(cl-loop for window in (or window-list (window-list))
|
||||
when (or (window-parameter window 'visible)
|
||||
(not (window-dedicated-p window)))
|
||||
collect window))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-visible-buffers (&optional buffer-list)
|
||||
"Return a list of visible buffers (i.e. not buried)."
|
||||
(let ((buffers (delete-dups (mapcar #'window-buffer (window-list)))))
|
||||
(if buffer-list
|
||||
(cl-delete-if (lambda (b) (memq b buffer-list))
|
||||
buffers)
|
||||
(delete-dups buffers))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-buried-buffers (&optional buffer-list)
|
||||
"Get a list of buffers that are buried."
|
||||
(cl-remove-if #'get-buffer-window (or buffer-list (doom-buffer-list))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-matching-buffers (pattern &optional buffer-list)
|
||||
"Get a list of all buffers that match the regex PATTERN."
|
||||
(cl-loop for buf in (or buffer-list (doom-buffer-list))
|
||||
when (string-match-p pattern (buffer-name buf))
|
||||
collect buf))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-set-buffer-real (buffer flag)
|
||||
"Forcibly mark BUFFER as FLAG (non-nil = real).
|
||||
|
||||
See `doom-real-buffer-p' for an explanation for real buffers."
|
||||
(with-current-buffer buffer
|
||||
(setq doom-real-buffer-p flag)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-kill-buffer-and-windows (buffer)
|
||||
"Kill the buffer and delete all the windows it's displayed in."
|
||||
(dolist (window (get-buffer-window-list buffer))
|
||||
(unless (one-window-p t)
|
||||
(delete-window window)))
|
||||
(kill-buffer buffer))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-fixup-windows (windows)
|
||||
"Ensure that each of WINDOWS is showing a real buffer or the fallback buffer."
|
||||
(dolist (window windows)
|
||||
(with-selected-window window
|
||||
(when (doom-unreal-buffer-p (window-buffer))
|
||||
(previous-buffer)
|
||||
(when (doom-unreal-buffer-p (window-buffer))
|
||||
(switch-to-buffer (doom-fallback-buffer)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-kill-buffer-fixup-windows (buffer)
|
||||
"Kill the BUFFER and ensure all the windows it was displayed in have switched
|
||||
to a real buffer or the fallback buffer."
|
||||
(let ((windows (get-buffer-window-list buffer)))
|
||||
(kill-buffer buffer)
|
||||
(doom-fixup-windows (cl-remove-if-not #'window-live-p windows))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-kill-buffers-fixup-windows (buffers)
|
||||
"Kill the BUFFERS and ensure all the windows they were displayed in have
|
||||
switched to a real buffer or the fallback buffer."
|
||||
(let ((seen-windows (make-hash-table :test 'eq :size 8)))
|
||||
(dolist (buffer buffers)
|
||||
(let ((windows (get-buffer-window-list buffer)))
|
||||
(kill-buffer buffer)
|
||||
(dolist (window (cl-remove-if-not #'window-live-p windows))
|
||||
(puthash window t seen-windows))))
|
||||
(doom-fixup-windows (hash-table-keys seen-windows))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-kill-matching-buffers (pattern &optional buffer-list)
|
||||
"Kill all buffers (in current workspace OR in BUFFER-LIST) that match the
|
||||
regex PATTERN. Returns the number of killed buffers."
|
||||
(let ((buffers (doom-matching-buffers pattern buffer-list)))
|
||||
(dolist (buf buffers (length buffers))
|
||||
(kill-buffer buf))))
|
||||
|
||||
|
||||
;;
|
||||
;; Hooks
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-mark-buffer-as-real-h ()
|
||||
"Hook function that marks the current buffer as real.
|
||||
|
||||
See `doom-real-buffer-p' for an explanation for real buffers."
|
||||
(doom-set-buffer-real (current-buffer) t))
|
||||
|
||||
|
||||
;;
|
||||
;; Interactive commands
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/save-and-kill-buffer ()
|
||||
"Save the current buffer to file, then kill it."
|
||||
(interactive)
|
||||
(save-buffer)
|
||||
(kill-current-buffer))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/kill-this-buffer-in-all-windows (buffer &optional dont-save)
|
||||
"Kill BUFFER globally and ensure all windows previously showing this buffer
|
||||
have switched to a real buffer or the fallback buffer.
|
||||
|
||||
If DONT-SAVE, don't prompt to save modified buffers (discarding their changes)."
|
||||
(interactive
|
||||
(list (current-buffer) current-prefix-arg))
|
||||
(cl-assert (bufferp buffer) t)
|
||||
(when (and (buffer-modified-p buffer) dont-save)
|
||||
(with-current-buffer buffer
|
||||
(set-buffer-modified-p nil)))
|
||||
(doom-kill-buffer-fixup-windows buffer))
|
||||
|
||||
|
||||
(defun doom--message-or-count (interactive message count)
|
||||
(if interactive
|
||||
(message message count)
|
||||
count))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/kill-all-buffers (&optional buffer-list interactive)
|
||||
"Kill all buffers and closes their windows.
|
||||
|
||||
If the prefix arg is passed, doesn't close windows and only kill buffers that
|
||||
belong to the current project."
|
||||
(interactive
|
||||
(list (if current-prefix-arg
|
||||
(doom-project-buffer-list)
|
||||
(doom-buffer-list))
|
||||
t))
|
||||
(if (null buffer-list)
|
||||
(message "No buffers to kill")
|
||||
(save-some-buffers)
|
||||
(delete-other-windows)
|
||||
(when (memq (current-buffer) buffer-list)
|
||||
(switch-to-buffer (doom-fallback-buffer)))
|
||||
(mapc #'kill-buffer buffer-list)
|
||||
(doom--message-or-count
|
||||
interactive "Killed %d buffers"
|
||||
(- (length buffer-list)
|
||||
(length (cl-remove-if-not #'buffer-live-p buffer-list))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/kill-other-buffers (&optional buffer-list interactive)
|
||||
"Kill all other buffers (besides the current one).
|
||||
|
||||
If the prefix arg is passed, kill only buffers that belong to the current
|
||||
project."
|
||||
(interactive
|
||||
(list (delq (current-buffer)
|
||||
(if current-prefix-arg
|
||||
(doom-project-buffer-list)
|
||||
(doom-buffer-list)))
|
||||
t))
|
||||
(mapc #'doom-kill-buffer-and-windows buffer-list)
|
||||
(doom--message-or-count
|
||||
interactive "Killed %d other buffers"
|
||||
(- (length buffer-list)
|
||||
(length (cl-remove-if-not #'buffer-live-p buffer-list)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/kill-matching-buffers (pattern &optional buffer-list interactive)
|
||||
"Kill buffers that match PATTERN in BUFFER-LIST.
|
||||
|
||||
If the prefix arg is passed, only kill matching buffers in the current project."
|
||||
(interactive
|
||||
(list (read-regexp "Buffer pattern: ")
|
||||
(if current-prefix-arg
|
||||
(doom-project-buffer-list)
|
||||
(doom-buffer-list))
|
||||
t))
|
||||
(doom-kill-matching-buffers pattern buffer-list)
|
||||
(when interactive
|
||||
(message "Killed %d buffer(s)"
|
||||
(- (length buffer-list)
|
||||
(length (cl-remove-if-not #'buffer-live-p buffer-list))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/kill-buried-buffers (&optional buffer-list interactive)
|
||||
"Kill buffers that are buried.
|
||||
|
||||
If PROJECT-P (universal argument), only kill buried buffers belonging to the
|
||||
current project."
|
||||
(interactive
|
||||
(list (doom-buried-buffers
|
||||
(if current-prefix-arg (doom-project-buffer-list)))
|
||||
t))
|
||||
(mapc #'kill-buffer buffer-list)
|
||||
(doom--message-or-count
|
||||
interactive "Killed %d buried buffers"
|
||||
(- (length buffer-list)
|
||||
(length (cl-remove-if-not #'buffer-live-p buffer-list)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/kill-project-buffers (project &optional interactive)
|
||||
"Kill buffers for the specified PROJECT."
|
||||
(interactive
|
||||
(list (if-let (open-projects (doom-open-projects))
|
||||
(completing-read
|
||||
"Kill buffers for project: " open-projects
|
||||
nil t nil nil
|
||||
(if-let* ((project-root (doom-project-root))
|
||||
(project-root (abbreviate-file-name project-root))
|
||||
((member project-root open-projects)))
|
||||
project-root))
|
||||
(message "No projects are open!")
|
||||
nil)
|
||||
t))
|
||||
(when project
|
||||
(let ((buffer-list (doom-project-buffer-list project)))
|
||||
(doom-kill-buffers-fixup-windows buffer-list)
|
||||
(doom--message-or-count
|
||||
interactive "Killed %d project buffers"
|
||||
(- (length buffer-list)
|
||||
(length (cl-remove-if-not #'buffer-live-p buffer-list)))))))
|
||||
126
lisp/lib/config.el
Normal file
126
lisp/lib/config.el
Normal file
|
|
@ -0,0 +1,126 @@
|
|||
;;; lisp/lib/config.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defvar doom-bin-dir (expand-file-name "bin/" doom-emacs-dir))
|
||||
(defvar doom-bin (expand-file-name "doom" doom-bin-dir))
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-reloading-p nil
|
||||
"TODO")
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/open-private-config ()
|
||||
"Browse your `doom-private-dir'."
|
||||
(interactive)
|
||||
(unless (file-directory-p doom-private-dir)
|
||||
(make-directory doom-private-dir t))
|
||||
(doom-project-browse doom-private-dir))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/find-file-in-private-config ()
|
||||
"Search for a file in `doom-private-dir'."
|
||||
(interactive)
|
||||
(doom-project-find-file doom-private-dir))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/goto-private-init-file ()
|
||||
"Open your private init.el file.
|
||||
And jumps to your `doom!' block."
|
||||
(interactive)
|
||||
(find-file (expand-file-name "init.el" doom-private-dir))
|
||||
(goto-char
|
||||
(or (save-excursion
|
||||
(goto-char (point-min))
|
||||
(search-forward "(doom!" nil t))
|
||||
(point))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/goto-private-config-file ()
|
||||
"Open your private config.el file."
|
||||
(interactive)
|
||||
(find-file (expand-file-name "config.el" doom-private-dir)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/goto-private-packages-file ()
|
||||
"Open your private packages.el file."
|
||||
(interactive)
|
||||
(find-file (expand-file-name "packages.el" doom-private-dir)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Managements
|
||||
|
||||
(defmacro doom--if-compile (command on-success &optional on-failure)
|
||||
(declare (indent 2))
|
||||
`(let ((default-directory doom-emacs-dir))
|
||||
(with-current-buffer (compile ,command t)
|
||||
(let ((w (get-buffer-window (current-buffer))))
|
||||
(select-window w)
|
||||
(add-hook
|
||||
'compilation-finish-functions
|
||||
(lambda (_buf status)
|
||||
(if (equal status "finished\n")
|
||||
(progn
|
||||
(delete-window w)
|
||||
,on-success)
|
||||
,on-failure))
|
||||
nil 'local)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/reload ()
|
||||
"Reloads your private config.
|
||||
|
||||
This is experimental! It will try to do as `bin/doom sync' does, but from within
|
||||
this Emacs session. i.e. it reload autoloads files (if necessary), reloads your
|
||||
package list, and lastly, reloads your private config.el.
|
||||
|
||||
Runs `doom-after-reload-hook' afterwards."
|
||||
(interactive)
|
||||
(mapc #'require (cdr doom-incremental-packages))
|
||||
(doom--if-compile (format "%S sync -e" doom-bin)
|
||||
(let ((doom-reloading-p t))
|
||||
(doom-run-hooks 'doom-before-reload-hook)
|
||||
(load "doom-start")
|
||||
(with-demoted-errors "PRIVATE CONFIG ERROR: %s"
|
||||
(general-auto-unbind-keys)
|
||||
(unwind-protect
|
||||
(doom-initialize-modules 'force)
|
||||
(general-auto-unbind-keys t)))
|
||||
(doom-run-hooks 'doom-after-reload-hook)
|
||||
(message "Config successfully reloaded!"))
|
||||
(user-error "Failed to reload your config")))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/reload-autoloads ()
|
||||
"Reload only `doom-autoloads-file' and `doom-package-autoload-file'.
|
||||
|
||||
This is much faster and safer than `doom/reload', but not as comprehensive. This
|
||||
reloads your package and module visibility, but does not install new packages or
|
||||
remove orphaned ones. It also doesn't reload your private config.
|
||||
|
||||
It is useful to only pull in changes performed by 'doom sync' on the command
|
||||
line."
|
||||
(interactive)
|
||||
(load (file-name-sans-extension doom-autoloads-file) nil 'nomessage))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/reload-env ()
|
||||
"Reloads your envvar file.
|
||||
|
||||
DOES NOT REGENERATE IT. You must run 'doom env' in your shell OUTSIDE of Emacs.
|
||||
Doing so from within Emacs will taint your shell environment.
|
||||
|
||||
An envvar file contains a snapshot of your shell environment, which can be
|
||||
imported into Emacs."
|
||||
(interactive)
|
||||
(let ((default-directory doom-emacs-dir))
|
||||
(with-temp-buffer
|
||||
(doom-load-envvars-file doom-env-file)
|
||||
(message "Reloaded %S" (abbreviate-file-name doom-env-file)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/upgrade ()
|
||||
"Run 'doom upgrade' then prompt to restart Emacs."
|
||||
(interactive)
|
||||
(doom--if-compile (format "%S upgrade --force" doom-bin)
|
||||
(when (y-or-n-p "You must restart Emacs for the upgrade to take effect.\n\nRestart Emacs?")
|
||||
(doom/restart-and-restore))))
|
||||
408
lisp/lib/debug.el
Normal file
408
lisp/lib/debug.el
Normal file
|
|
@ -0,0 +1,408 @@
|
|||
;;; lisp/lib/debug.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;
|
||||
;;; Doom's debug mode
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-debug-variables
|
||||
'(async-debug
|
||||
debug-on-error
|
||||
(debugger . doom-debugger)
|
||||
(doom-print-level . debug)
|
||||
garbage-collection-messages
|
||||
gcmh-verbose
|
||||
init-file-debug
|
||||
jka-compr-verbose
|
||||
(message-log-max . 16384)
|
||||
url-debug
|
||||
use-package-verbose)
|
||||
"A list of variable to toggle on `doom-debug-mode'.
|
||||
|
||||
Each entry can be a variable symbol or a cons cell whose CAR is the variable
|
||||
symbol and CDR is the value to set it to when `doom-debug-mode' is activated.")
|
||||
|
||||
(defvar doom-debug--undefined-vars nil)
|
||||
|
||||
(defun doom-debug--watch-vars-h (&rest _)
|
||||
(when-let (bound-vars (cl-delete-if-not #'boundp doom-debug--undefined-vars))
|
||||
(doom-log "New variables available: %s" bound-vars)
|
||||
(let ((message-log-max nil))
|
||||
(doom-debug-mode -1)
|
||||
(doom-debug-mode +1))))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode doom-debug-mode
|
||||
"Toggle `debug-on-error' and `init-file-debug' for verbose logging."
|
||||
:init-value init-file-debug
|
||||
:global t
|
||||
(let ((enabled doom-debug-mode))
|
||||
(setq doom-debug--undefined-vars nil)
|
||||
(dolist (var doom-debug-variables)
|
||||
(cond ((listp var)
|
||||
(pcase-let ((`(,var . ,val) var))
|
||||
(if (boundp var)
|
||||
(set-default
|
||||
var (if (not enabled)
|
||||
(prog1 (get var 'initial-value)
|
||||
(put 'x 'initial-value nil))
|
||||
(put var 'initial-value (symbol-value var))
|
||||
val))
|
||||
(add-to-list 'doom-debug--undefined-vars var))))
|
||||
((if (boundp var)
|
||||
(set-default var enabled)
|
||||
(add-to-list 'doom-debug--undefined-vars var)))))
|
||||
(when (called-interactively-p 'any)
|
||||
(when (fboundp 'explain-pause-mode)
|
||||
(explain-pause-mode (if enabled +1 -1))))
|
||||
;; Watch for changes in `doom-debug-variables', or when packages load (and
|
||||
;; potentially define one of `doom-debug-variables'), in case some of them
|
||||
;; aren't defined when `doom-debug-mode' is first loaded.
|
||||
(cond (enabled
|
||||
(message "Debug mode enabled! (Run 'M-x view-echo-area-messages' to open the log buffer)")
|
||||
;; Produce more helpful (and visible) error messages from errors
|
||||
;; emitted from hooks (particularly mode hooks), that usually go
|
||||
;; unnoticed otherwise.
|
||||
(advice-add #'run-hooks :override #'doom-run-hooks)
|
||||
;; Add time stamps to lines in *Messages*
|
||||
(advice-add #'message :before #'doom--timestamped-message-a)
|
||||
(add-variable-watcher 'doom-debug-variables #'doom-debug--watch-vars-h)
|
||||
(add-hook 'after-load-functions #'doom-debug--watch-vars-h))
|
||||
(t
|
||||
(advice-remove #'run-hooks #'doom-run-hooks)
|
||||
(advice-remove #'message #'doom--timestamped-message-a)
|
||||
(remove-variable-watcher 'doom-debug-variables #'doom-debug--watch-vars-h)
|
||||
(remove-hook 'after-load-functions #'doom-debug--watch-vars-h)
|
||||
(message "Debug mode disabled!")))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Custom debuggers
|
||||
|
||||
(autoload 'backtrace-get-frames "backtrace")
|
||||
|
||||
(defun doom-backtrace ()
|
||||
"Return a stack trace as a list of `backtrace-frame' objects."
|
||||
;; (let* ((n 0)
|
||||
;; (frame (backtrace-frame n))
|
||||
;; (frame-list nil)
|
||||
;; (in-program-stack nil))
|
||||
;; (while frame
|
||||
;; (when in-program-stack
|
||||
;; (push (cdr frame) frame-list))
|
||||
;; (when (eq (elt frame 1) debugger)
|
||||
;; (setq in-program-stack t))
|
||||
;; ;; (when (and (eq (elt frame 1) 'doom-cli-execute)
|
||||
;; ;; (eq (elt frame 2) :doom))
|
||||
;; ;; (setq in-program-stack nil))
|
||||
;; (setq n (1+ n)
|
||||
;; frame (backtrace-frame n)))
|
||||
;; (nreverse frame-list))
|
||||
(cdr (backtrace-get-frames debugger)))
|
||||
|
||||
(defun doom-backtrace-write-to-file (backtrace file)
|
||||
"Write BACKTRACE to FILE with appropriate boilerplate."
|
||||
(make-directory (file-name-directory file) t)
|
||||
(let ((doom-print-indent 0))
|
||||
(with-temp-file file
|
||||
(insert ";; -*- lisp-interaction -*-\n")
|
||||
(insert ";; vim: set ft=lisp:\n")
|
||||
(insert (format ";; command=%S\n" command-line-args))
|
||||
(insert (format ";; date=%S\n\n" (format-time-string "%Y-%m-%d %H-%M-%S" before-init-time)))
|
||||
(insert ";;;; ENVIRONMENT\n" (with-output-to-string (doom/version)) "\n")
|
||||
(let ((standard-output (current-buffer))
|
||||
(print-quoted t)
|
||||
(print-escape-newlines t)
|
||||
(print-escape-control-characters t)
|
||||
(print-symbols-bare t)
|
||||
(print-level nil)
|
||||
(print-circle nil)
|
||||
(n -1))
|
||||
(mapc (lambda (frame)
|
||||
(princ (format ";;;; %d\n" (cl-incf n)))
|
||||
(pp (list (cons (backtrace-frame-fun frame)
|
||||
(backtrace-frame-args frame))
|
||||
(backtrace-frame-locals frame)))
|
||||
(terpri))
|
||||
backtrace))
|
||||
file)))
|
||||
|
||||
(defun doom-debugger (&rest args)
|
||||
"Enter `debugger' in interactive sessions, `doom-cli-debugger' otherwise.
|
||||
|
||||
Writes backtraces to file and ensures the backtrace is recorded, so the user can
|
||||
always access it."
|
||||
(let ((backtrace (doom-backtrace)))
|
||||
;; Work around Emacs's heuristic (in eval.c) for detecting errors in the
|
||||
;; debugger, which would run this handler again on subsequent calls. Taken
|
||||
;; from `ert--run-test-debugger'.
|
||||
(cl-incf num-nonmacro-input-events)
|
||||
;; TODO Write backtraces to file
|
||||
;; TODO Write backtrace to a buffer in case recursive error interupts the
|
||||
;; debugger (happens more often than it should).
|
||||
(apply #'debug args)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Time-stamped *Message* logs
|
||||
|
||||
(defun doom--timestamped-message-a (format-string &rest args)
|
||||
"Advice to run before `message' that prepends a timestamp to each message.
|
||||
|
||||
Activate this advice with:
|
||||
(advice-add 'message :before 'doom--timestamped-message-a)"
|
||||
(when (and (stringp format-string)
|
||||
message-log-max
|
||||
(not (string-equal format-string "%s%s")))
|
||||
(with-current-buffer "*Messages*"
|
||||
(let ((timestamp (format-time-string "[%F %T] " (current-time)))
|
||||
(deactivate-mark nil))
|
||||
(with-silent-modifications
|
||||
(goto-char (point-max))
|
||||
(if (not (bolp))
|
||||
(newline))
|
||||
(insert timestamp))))
|
||||
(let ((window (get-buffer-window "*Messages*")))
|
||||
(when (and window (not (equal (selected-window) window)))
|
||||
(with-current-buffer "*Messages*"
|
||||
(goto-char (point-max))
|
||||
(set-window-point window (point-max)))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Hooks
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-run-all-startup-hooks-h ()
|
||||
"Run all startup Emacs hooks. Meant to be executed after starting Emacs with
|
||||
-q or -Q, for example:
|
||||
|
||||
emacs -Q -l init.el -f doom-run-all-startup-hooks-h"
|
||||
(setq after-init-time (current-time))
|
||||
(let ((inhibit-startup-hooks nil))
|
||||
(doom-run-hooks 'after-init-hook
|
||||
'delayed-warnings-hook
|
||||
'emacs-startup-hook
|
||||
'tty-setup-hook
|
||||
'window-setup-hook)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(defsubst doom--collect-forms-in (file form)
|
||||
(when (file-readable-p file)
|
||||
(let (forms)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(with-syntax-table emacs-lisp-mode-syntax-table
|
||||
(while (re-search-forward (format "(%s " (regexp-quote form)) nil t)
|
||||
(let ((ppss (syntax-ppss)))
|
||||
(unless (or (nth 4 ppss)
|
||||
(nth 3 ppss))
|
||||
(save-excursion
|
||||
(goto-char (match-beginning 0))
|
||||
(push (sexp-at-point) forms))))))
|
||||
(nreverse forms)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-info ()
|
||||
"Returns diagnostic information about the current Emacs session in markdown,
|
||||
ready to be pasted in a bug report on github."
|
||||
(require 'vc-git)
|
||||
(require 'doom-packages)
|
||||
(let ((default-directory doom-emacs-dir))
|
||||
(letf! ((defun sh (&rest args) (cdr (apply #'doom-call-process args)))
|
||||
(defun cat (file &optional limit)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file nil 0 limit)
|
||||
(buffer-string)))
|
||||
(defun abbrev-path (path)
|
||||
(replace-regexp-in-string
|
||||
(regexp-opt (list (user-login-name)) 'words) "$USER"
|
||||
(abbreviate-file-name path)))
|
||||
(defun symlink-path (file)
|
||||
(format "%s%s" (abbrev-path file)
|
||||
(if (file-symlink-p file) ""
|
||||
(concat " -> " (abbrev-path (file-truename file)))))))
|
||||
`((generated . ,(format-time-string "%b %d, %Y %H:%M:%S"))
|
||||
(system . ,(delq
|
||||
nil (list (doom-system-distro-version)
|
||||
(when (executable-find "uname")
|
||||
(sh "uname" "-msr"))
|
||||
(window-system))))
|
||||
(emacs . ,(delq
|
||||
nil (list emacs-version
|
||||
(bound-and-true-p emacs-repository-branch)
|
||||
(and (stringp emacs-repository-version)
|
||||
(substring emacs-repository-version 0 9))
|
||||
(symlink-path doom-emacs-dir))))
|
||||
(doom . ,(list doom-version
|
||||
(sh "git" "log" "-1" "--format=%D %h %ci")
|
||||
(symlink-path doom-private-dir)))
|
||||
(shell . ,(abbrev-path shell-file-name))
|
||||
(features . ,system-configuration-features)
|
||||
(traits
|
||||
. ,(mapcar
|
||||
#'symbol-name
|
||||
(delq
|
||||
nil (list (cond (noninteractive 'batch)
|
||||
((display-graphic-p) 'gui)
|
||||
('tty))
|
||||
(if (daemonp) 'daemon)
|
||||
(if (and (require 'server)
|
||||
(server-running-p))
|
||||
'server-running)
|
||||
(if (boundp 'chemacs-version)
|
||||
(intern (format "chemacs-%s" chemacs-version)))
|
||||
(if (file-exists-p doom-env-file)
|
||||
'envvar-file)
|
||||
(if (featurep 'exec-path-from-shell)
|
||||
'exec-path-from-shell)
|
||||
(if (file-symlink-p doom-emacs-dir)
|
||||
'symlinked-emacsdir)
|
||||
(if (file-symlink-p doom-private-dir)
|
||||
'symlinked-doomdir)
|
||||
(if (and (stringp custom-file) (file-exists-p custom-file))
|
||||
'custom-file)
|
||||
(if (doom-files-in `(,@doom-modules-dirs
|
||||
,doom-core-dir
|
||||
,doom-private-dir)
|
||||
:type 'files :match "\\.elc$")
|
||||
'byte-compiled-config)))))
|
||||
(custom
|
||||
,@(when (and (stringp custom-file)
|
||||
(file-exists-p custom-file))
|
||||
(cl-loop for (type var _) in (get 'user 'theme-settings)
|
||||
if (eq type 'theme-value)
|
||||
collect var)))
|
||||
(modules
|
||||
,@(or (cl-loop with cat = nil
|
||||
for key being the hash-keys of doom-modules
|
||||
if (or (not cat)
|
||||
(not (eq cat (car key))))
|
||||
do (setq cat (car key))
|
||||
and collect cat
|
||||
collect
|
||||
(let* ((flags (doom-module-get cat (cdr key) :flags))
|
||||
(path (doom-module-get cat (cdr key) :path))
|
||||
(module
|
||||
(append
|
||||
(cond ((null path)
|
||||
(list '&nopath))
|
||||
((not (file-in-directory-p path doom-modules-dir))
|
||||
(list '&user)))
|
||||
(if flags
|
||||
`(,(cdr key) ,@flags)
|
||||
(list (cdr key))))))
|
||||
(if (= (length module) 1)
|
||||
(car module)
|
||||
module)))
|
||||
'("n/a")))
|
||||
(packages
|
||||
,@(condition-case e
|
||||
(mapcar
|
||||
#'cdr (doom--collect-forms-in
|
||||
(doom-path doom-private-dir "packages.el")
|
||||
"package!"))
|
||||
(error (format "<%S>" e))))
|
||||
(unpin
|
||||
,@(condition-case e
|
||||
(mapcan #'identity
|
||||
(mapcar
|
||||
#'cdr (doom--collect-forms-in
|
||||
(doom-path doom-private-dir "packages.el")
|
||||
"unpin!")))
|
||||
(error (list (format "<%S>" e)))))
|
||||
(elpa
|
||||
,@(condition-case e
|
||||
(progn
|
||||
(unless (bound-and-true-p package--initialized)
|
||||
(package-initialize))
|
||||
(cl-loop for (name . _) in package-alist
|
||||
collect (format "%s" name)))
|
||||
(error (format "<%S>" e))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-info-string (&optional width nocolor)
|
||||
"Return the `doom-info' as a compact string.
|
||||
|
||||
FILL-COLUMN determines the column at which lines will be broken."
|
||||
(with-temp-buffer
|
||||
(let ((doom-print-backend (unless nocolor doom-print-backend))
|
||||
(doom-print-indent 0))
|
||||
(dolist (spec (cl-remove-if-not #'cdr (doom-info)) (buffer-string))
|
||||
;; FIXME Refactor this horrible cludge, either here or in `format!'
|
||||
(insert! ((bold "%-10s ") (symbol-name (car spec)))
|
||||
("%s\n"
|
||||
(string-trim-left
|
||||
(indent
|
||||
(fill
|
||||
(if (listp (cdr spec))
|
||||
(mapconcat (doom-partial #'format "%s")
|
||||
(cdr spec)
|
||||
" ")
|
||||
(cdr spec))
|
||||
(- (or width 80) 11))
|
||||
11))))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/version ()
|
||||
"Display the running version of Doom core, module sources, and Emacs."
|
||||
(interactive)
|
||||
(print! "%s\n%s\n%s"
|
||||
(format "%-13s v%-15s %s"
|
||||
"GNU Emacs"
|
||||
emacs-version
|
||||
emacs-repository-version)
|
||||
(format "%-13s v%-15s %s"
|
||||
"Doom core"
|
||||
doom-version
|
||||
(or (cdr (doom-call-process
|
||||
"git" "-C" doom-emacs-dir
|
||||
"log" "-1" "--format=%D %h %ci"))
|
||||
"n/a"))
|
||||
;; NOTE This is a placeholder. Our modules will be moved to its own
|
||||
;; repo eventually, and Doom core will later be capable of managing
|
||||
;; them like package sources.
|
||||
(format "%-13s v%-15s %s"
|
||||
"Doom modules"
|
||||
doom-modules-version
|
||||
(or (cdr (doom-call-process
|
||||
"git" "-C" doom-modules-dir
|
||||
"log" "-1" "--format=%D %h %ci"))
|
||||
"n/a"))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/info ()
|
||||
"Collects some debug information about your Emacs session, formats it and
|
||||
copies it to your clipboard, ready to be pasted into bug reports!"
|
||||
(interactive)
|
||||
(let ((buffer (get-buffer-create "*doom info*")))
|
||||
(with-current-buffer buffer
|
||||
(setq buffer-read-only t)
|
||||
(with-silent-modifications
|
||||
(erase-buffer)
|
||||
(insert (doom-info-string 86)))
|
||||
(pop-to-buffer buffer)
|
||||
(kill-new (buffer-string))
|
||||
(when (y-or-n-p "Your doom-info was copied to the clipboard.\n\nOpen pastebin.com?")
|
||||
(browse-url "https://pastebin.com")))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Profiling
|
||||
|
||||
(defvar doom--profiler nil)
|
||||
;;;###autoload
|
||||
(defun doom/toggle-profiler ()
|
||||
"Toggle the Emacs profiler. Run it again to see the profiling report."
|
||||
(interactive)
|
||||
(if (not doom--profiler)
|
||||
(profiler-start 'cpu+mem)
|
||||
(profiler-report)
|
||||
(profiler-stop))
|
||||
(setq doom--profiler (not doom--profiler)))
|
||||
350
lisp/lib/files.el
Normal file
350
lisp/lib/files.el
Normal file
|
|
@ -0,0 +1,350 @@
|
|||
;;; lisp/lib/files.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defun doom--resolve-path-forms (spec &optional directory)
|
||||
"Converts a simple nested series of or/and forms into a series of
|
||||
`file-exists-p' checks.
|
||||
|
||||
For example
|
||||
|
||||
(doom--resolve-path-forms
|
||||
'(or A (and B C))
|
||||
\"~\")
|
||||
|
||||
Returns (approximately):
|
||||
|
||||
'(let* ((_directory \"~\")
|
||||
(A (expand-file-name A _directory))
|
||||
(B (expand-file-name B _directory))
|
||||
(C (expand-file-name C _directory)))
|
||||
(or (and (file-exists-p A) A)
|
||||
(and (if (file-exists-p B) B)
|
||||
(if (file-exists-p C) C))))
|
||||
|
||||
This is used by `file-exists-p!' and `project-file-exists-p!'."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(if (and (listp spec)
|
||||
(memq (car spec) '(or and)))
|
||||
(cons (car spec)
|
||||
(mapcar (doom-rpartial #'doom--resolve-path-forms directory)
|
||||
(cdr spec)))
|
||||
(let ((filevar (make-symbol "file")))
|
||||
`(let ((,filevar ,spec))
|
||||
(and (stringp ,filevar)
|
||||
,(if directory
|
||||
`(let ((default-directory ,directory))
|
||||
(file-exists-p ,filevar))
|
||||
`(file-exists-p ,filevar))
|
||||
,filevar)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-path (&rest segments)
|
||||
"Constructs a file path from SEGMENTS.
|
||||
Ignores `nil' elements in SEGMENTS."
|
||||
(let ((segments (remq nil segments))
|
||||
file-name-handler-alist
|
||||
dir)
|
||||
(while segments
|
||||
(setq segment (pop segments)
|
||||
dir (expand-file-name
|
||||
(if (listp segment)
|
||||
(apply #'doom-path dir segment)
|
||||
segment)
|
||||
dir)))
|
||||
dir))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-glob (&rest segments)
|
||||
"Construct a path from SEGMENTS and expand glob patterns.
|
||||
Returns nil if the path doesn't exist.
|
||||
Ignores `nil' elements in SEGMENTS."
|
||||
(let (case-fold-search)
|
||||
(file-expand-wildcards (apply #'doom-path segments) t)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-dir (&rest segments)
|
||||
"Constructs a path from SEGMENTS.
|
||||
See `doom-path'.
|
||||
Ignores `nil' elements in SEGMENTS."
|
||||
(when-let (path (doom-path segments))
|
||||
(directory-file-name path)))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun doom-files-in
|
||||
(paths &rest rest
|
||||
&key
|
||||
filter
|
||||
map
|
||||
(full t)
|
||||
(follow-symlinks t)
|
||||
(type 'files)
|
||||
(relative-to (unless full default-directory))
|
||||
(depth 99999)
|
||||
(mindepth 0)
|
||||
(match "/[^._][^/]+"))
|
||||
"Return a list of files/directories in PATHS (one string or a list of them).
|
||||
|
||||
FILTER is a function or symbol that takes one argument (the path). If it returns
|
||||
non-nil, the entry will be excluded.
|
||||
|
||||
MAP is a function or symbol which will be used to transform each entry in the
|
||||
results.
|
||||
|
||||
TYPE determines what kind of path will be included in the results. This can be t
|
||||
(files and folders), 'files or 'dirs.
|
||||
|
||||
By default, this function returns paths relative to PATH-OR-PATHS if it is a
|
||||
single path. If it a list of paths, this function returns absolute paths.
|
||||
Otherwise, by setting RELATIVE-TO to a path, the results will be transformed to
|
||||
be relative to it.
|
||||
|
||||
The search recurses up to DEPTH and no further. DEPTH is an integer.
|
||||
|
||||
MATCH is a string regexp. Only entries that match it will be included."
|
||||
(let (result)
|
||||
(dolist (file (mapcan (doom-rpartial #'doom-glob "*") (doom-enlist paths)))
|
||||
(cond ((file-directory-p file)
|
||||
(appendq!
|
||||
result
|
||||
(and (memq type '(t dirs))
|
||||
(string-match-p match file)
|
||||
(not (and filter (funcall filter file)))
|
||||
(not (and (file-symlink-p file)
|
||||
(not follow-symlinks)))
|
||||
(<= mindepth 0)
|
||||
(list (if relative-to
|
||||
(file-relative-name file relative-to)
|
||||
file)))
|
||||
(and (>= depth 1)
|
||||
(apply #'doom-files-in file
|
||||
(append (list :mindepth (1- mindepth)
|
||||
:depth (1- depth)
|
||||
:relative-to relative-to
|
||||
:map nil)
|
||||
rest)))))
|
||||
((and (memq type '(t files))
|
||||
(string-match-p match file)
|
||||
(not (and filter (funcall filter file)))
|
||||
(<= mindepth 0))
|
||||
(push (if relative-to
|
||||
(file-relative-name file relative-to)
|
||||
file)
|
||||
result))))
|
||||
(if map
|
||||
(mapcar map result)
|
||||
result)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-file-cookie-p (file &optional cookie null-value)
|
||||
"Returns the evaluated result of FORM in a ;;;###COOKIE FORM at the top of
|
||||
FILE.
|
||||
|
||||
If COOKIE doesn't exist, or cookie isn't within the first 256 bytes of FILE,
|
||||
return NULL-VALUE."
|
||||
(unless (file-exists-p file)
|
||||
(signal 'file-missing file))
|
||||
(unless (file-readable-p file)
|
||||
(error "%S is unreadable" file))
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file nil 0 256)
|
||||
(if (re-search-forward (format "^;;;###%s " (regexp-quote (or cookie "if")))
|
||||
nil t)
|
||||
(let ((load-file-name file))
|
||||
(eval (sexp-at-point) t))
|
||||
null-value)))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro file-exists-p! (files &optional directory)
|
||||
"Returns non-nil if the FILES in DIRECTORY all exist.
|
||||
|
||||
DIRECTORY is a path; defaults to `default-directory'.
|
||||
|
||||
Returns the last file found to meet the rules set by FILES, which can be a
|
||||
single file or nested compound statement of `and' and `or' statements."
|
||||
`(let ((p ,(doom--resolve-path-forms files directory)))
|
||||
(and p (expand-file-name p ,directory))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-file-size (file &optional dir)
|
||||
"Returns the size of FILE (in DIR) in bytes."
|
||||
(let ((file (expand-file-name file dir)))
|
||||
(unless (file-exists-p file)
|
||||
(error "Couldn't find file %S" file))
|
||||
(unless (file-readable-p file)
|
||||
(error "File %S is unreadable; can't acquire its filesize"
|
||||
file))
|
||||
(nth 7 (file-attributes file))))
|
||||
|
||||
(defvar w32-get-true-file-attributes)
|
||||
;;;###autoload
|
||||
(defun doom-directory-size (dir)
|
||||
"Returns the size of FILE (in DIR) in kilobytes."
|
||||
(unless (file-directory-p dir)
|
||||
(error "Directory %S does not exist" dir))
|
||||
(if (executable-find "du")
|
||||
(/ (string-to-number (cdr (doom-call-process "du" "-sb" dir)))
|
||||
1024.0)
|
||||
;; REVIEW This is slow and terribly inaccurate, but it's something
|
||||
(let ((w32-get-true-file-attributes t)
|
||||
(file-name-handler-alist dir)
|
||||
(max-lisp-eval-depth 5000)
|
||||
(sum 0.0))
|
||||
(dolist (attrs (directory-files-and-attributes dir nil nil t) sum)
|
||||
(unless (member (car attrs) '("." ".."))
|
||||
(cl-incf
|
||||
sum (if (eq (nth 1 attrs) t) ; is directory
|
||||
(doom-directory-size (expand-file-name (car attrs) dir))
|
||||
(/ (nth 8 attrs) 1024.0))))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(defun doom--update-files (&rest files)
|
||||
"Ensure FILES are updated in `recentf', `magit' and `save-place'."
|
||||
(let (toplevels)
|
||||
(dolist (file files)
|
||||
(when (featurep 'vc)
|
||||
(vc-file-clearprops file)
|
||||
(when-let (buffer (get-file-buffer file))
|
||||
(with-current-buffer buffer
|
||||
(vc-refresh-state))))
|
||||
(when (featurep 'magit)
|
||||
(when-let (default-directory (magit-toplevel (file-name-directory file)))
|
||||
(cl-pushnew default-directory toplevels)))
|
||||
(unless (file-readable-p file)
|
||||
(when (bound-and-true-p recentf-mode)
|
||||
(recentf-remove-if-non-kept file))
|
||||
(when (and (bound-and-true-p projectile-mode)
|
||||
(doom-project-p)
|
||||
(projectile-file-cached-p file (doom-project-root)))
|
||||
(projectile-purge-file-from-cache file))))
|
||||
(dolist (default-directory toplevels)
|
||||
(magit-refresh))
|
||||
(when (bound-and-true-p save-place-mode)
|
||||
(save-place-forget-unreadable-files))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/delete-this-file (&optional path force-p)
|
||||
"Delete PATH, kill its buffers and expunge it from vc/magit cache.
|
||||
|
||||
If PATH is not specified, default to the current buffer's file.
|
||||
|
||||
If FORCE-P, delete without confirmation."
|
||||
(interactive
|
||||
(list (buffer-file-name (buffer-base-buffer))
|
||||
current-prefix-arg))
|
||||
(let* ((path (or path (buffer-file-name (buffer-base-buffer))))
|
||||
(short-path (abbreviate-file-name path)))
|
||||
(unless (and path (file-exists-p path))
|
||||
(user-error "Buffer is not visiting any file"))
|
||||
(unless (file-exists-p path)
|
||||
(error "File doesn't exist: %s" path))
|
||||
(unless (or force-p (y-or-n-p (format "Really delete %S?" short-path)))
|
||||
(user-error "Aborted"))
|
||||
(let ((buf (current-buffer)))
|
||||
(unwind-protect
|
||||
(progn (delete-file path t) t)
|
||||
(if (file-exists-p path)
|
||||
(error "Failed to delete %S" short-path)
|
||||
;; Ensures that windows displaying this buffer will be switched to
|
||||
;; real buffers (`doom-real-buffer-p')
|
||||
(doom/kill-this-buffer-in-all-windows buf t)
|
||||
(doom--update-files path)
|
||||
(message "Deleted %S" short-path))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/copy-this-file (new-path &optional force-p)
|
||||
"Copy current buffer's file to NEW-PATH.
|
||||
|
||||
If FORCE-P, overwrite the destination file if it exists, without confirmation."
|
||||
(interactive
|
||||
(list (read-file-name "Copy file to: ")
|
||||
current-prefix-arg))
|
||||
(unless (and buffer-file-name (file-exists-p buffer-file-name))
|
||||
(user-error "Buffer is not visiting any file"))
|
||||
(let ((old-path (buffer-file-name (buffer-base-buffer)))
|
||||
(new-path (expand-file-name new-path)))
|
||||
(make-directory (file-name-directory new-path) 't)
|
||||
(copy-file old-path new-path (or force-p 1))
|
||||
(doom--update-files old-path new-path)
|
||||
(message "File copied to %S" (abbreviate-file-name new-path))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/move-this-file (new-path &optional force-p)
|
||||
"Move current buffer's file to NEW-PATH.
|
||||
|
||||
If FORCE-P, overwrite the destination file if it exists, without confirmation."
|
||||
(interactive
|
||||
(list (read-file-name "Move file to: ")
|
||||
current-prefix-arg))
|
||||
(unless (and buffer-file-name (file-exists-p buffer-file-name))
|
||||
(user-error "Buffer is not visiting any file"))
|
||||
(let ((old-path (buffer-file-name (buffer-base-buffer)))
|
||||
(new-path (expand-file-name new-path)))
|
||||
(when (directory-name-p new-path)
|
||||
(setq new-path (concat new-path (file-name-nondirectory old-path))))
|
||||
(make-directory (file-name-directory new-path) 't)
|
||||
(rename-file old-path new-path (or force-p 1))
|
||||
(set-visited-file-name new-path t t)
|
||||
(doom--update-files old-path new-path)
|
||||
(message "File moved to %S" (abbreviate-file-name new-path))))
|
||||
|
||||
(defun doom--sudo-file-path (file)
|
||||
(let ((host (or (file-remote-p file 'host) "localhost")))
|
||||
(concat "/" (when (file-remote-p file)
|
||||
(concat (file-remote-p file 'method) ":"
|
||||
(if-let (user (file-remote-p file 'user))
|
||||
(concat user "@" host)
|
||||
host)
|
||||
"|"))
|
||||
"sudo:root@" host
|
||||
":" (or (file-remote-p file 'localname)
|
||||
file))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/sudo-find-file (file)
|
||||
"Open FILE as root."
|
||||
(interactive "FOpen file as root: ")
|
||||
(find-file (doom--sudo-file-path file)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/sudo-this-file ()
|
||||
"Open the current file as root."
|
||||
(interactive)
|
||||
(find-file
|
||||
(doom--sudo-file-path
|
||||
(or buffer-file-name
|
||||
(when (or (derived-mode-p 'dired-mode)
|
||||
(derived-mode-p 'wdired-mode))
|
||||
default-directory)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/sudo-save-buffer ()
|
||||
"Save this file as root."
|
||||
(interactive)
|
||||
(let ((file (doom--sudo-file-path buffer-file-name)))
|
||||
(if-let (buffer (find-file-noselect file))
|
||||
(let ((origin (current-buffer)))
|
||||
(copy-to-buffer buffer (point-min) (point-max))
|
||||
(unwind-protect
|
||||
(with-current-buffer buffer
|
||||
(save-buffer))
|
||||
(unless (eq origin buffer)
|
||||
(kill-buffer buffer))
|
||||
(with-current-buffer origin
|
||||
(revert-buffer t t))))
|
||||
(user-error "Unable to open %S" file))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/remove-recent-file (file)
|
||||
"Remove FILE from your recently-opened-files list."
|
||||
(interactive
|
||||
(list (completing-read "Remove recent file: " recentf-list
|
||||
nil t)))
|
||||
(setq recentf-list (delete file recentf-list))
|
||||
(recentf-save-list)
|
||||
(message "Removed %S from `recentf-list'" (abbreviate-file-name file)))
|
||||
180
lisp/lib/fonts.el
Normal file
180
lisp/lib/fonts.el
Normal file
|
|
@ -0,0 +1,180 @@
|
|||
;;; lisp/lib/fonts.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-font-increment 2
|
||||
"How many steps to increase the font size each time `doom/increase-font-size'
|
||||
or `doom/decrease-font-size' are invoked.")
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-big-font nil
|
||||
"The font to use for `doom-big-font-mode'.
|
||||
If nil, `doom-font' will be used, scaled up by `doom-big-font-increment'. See
|
||||
`doom-font' for details on acceptable values for this variable.")
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-big-font-increment 4
|
||||
"How many steps to increase the font size (with `doom-font' as the base) when
|
||||
`doom-big-font-mode' is enabled and `doom-big-font' is nil.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Library
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-normalize-font (font)
|
||||
"Return FONT as a normalized font spec.
|
||||
|
||||
The font will be normalized (i.e. :weight, :slant, and :width will set to
|
||||
'normal if not specified) before it is converted.
|
||||
|
||||
FONT can be a `font-spec', a font object, an XFT font string, or an XLFD font
|
||||
string."
|
||||
(cl-check-type font (or font string vector))
|
||||
(when (and (stringp font)
|
||||
(string-prefix-p "-" font))
|
||||
(setq font (x-decompose-font-name font)))
|
||||
(let* ((font
|
||||
(cond ((stringp font)
|
||||
(dolist (prop '("weight" "slant" "width") (aref (font-info font) 0))
|
||||
(unless (string-match-p (format ":%s=" prop) font)
|
||||
(setq font (concat font ":" prop "=normal")))))
|
||||
((fontp font)
|
||||
(dolist (prop '(:weight :slant :width) (font-xlfd-name font))
|
||||
(unless (font-get font prop)
|
||||
(font-put font prop 'normal))))
|
||||
((vectorp font)
|
||||
(dolist (i '(1 2 3) (x-compose-font-name font))
|
||||
(unless (aref font i)
|
||||
(aset font i "normal"))))))
|
||||
(font (x-resolve-font-name font))
|
||||
(font (font-spec :name font)))
|
||||
(unless (font-get font :size)
|
||||
(font-put font :size
|
||||
(font-get (font-spec :name (face-font 'default))
|
||||
:size)))
|
||||
font))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-adjust-font-size (increment &optional fixed-size-p font-alist)
|
||||
"Increase size of font in FRAME by INCREMENT.
|
||||
|
||||
If FIXED-SIZE-P is non-nil, treat INCREMENT as a font size, rather than a
|
||||
scaling factor.
|
||||
|
||||
FONT-ALIST is an alist give temporary values to certain Doom font variables,
|
||||
like `doom-font' or `doom-variable-pitch-font'. e.g.
|
||||
|
||||
`((doom-font . ,(font-spec :family \"Sans Serif\" :size 12)))
|
||||
|
||||
Doesn't work in terminal Emacs."
|
||||
(unless (display-multi-font-p)
|
||||
(user-error "Cannot resize fonts in terminal Emacs"))
|
||||
(condition-case-unless-debug e
|
||||
(let (changed)
|
||||
(dolist (sym '((doom-font . default)
|
||||
(doom-serif-font . fixed-pitch-serif)
|
||||
(doom-variable-pitch-font . variable-pitch))
|
||||
(when changed
|
||||
(doom-init-fonts-h 'reload)
|
||||
t))
|
||||
(cl-destructuring-bind (var . face) sym
|
||||
(if (null increment)
|
||||
(when (get var 'initial-value)
|
||||
(set var (get var 'initial-value))
|
||||
(put var 'initial-value nil)
|
||||
(setq changed t))
|
||||
(let* ((original-font (or (symbol-value var)
|
||||
(face-font face t)
|
||||
(with-temp-buffer (face-font face))))
|
||||
(font (doom-normalize-font original-font))
|
||||
(dfont
|
||||
(or (if-let* ((remap-font (alist-get var font-alist))
|
||||
(remap-xlfd (doom-normalize-font remap-font)))
|
||||
remap-xlfd
|
||||
(purecopy font))
|
||||
(error "Could not decompose %s font" var))))
|
||||
(let* ((step (if fixed-size-p 0 (* increment doom-font-increment)))
|
||||
(orig-size (font-get font :size))
|
||||
(new-size (if fixed-size-p increment (+ orig-size step))))
|
||||
(cond ((<= new-size 0)
|
||||
(error "`%s' font is too small to be resized (%d)" var new-size))
|
||||
((= orig-size new-size)
|
||||
(user-error "Could not resize `%s' for some reason" var))
|
||||
((setq changed t)
|
||||
(unless (get var 'initial-value)
|
||||
(put var 'initial-value original-font))
|
||||
(font-put dfont :size new-size)
|
||||
(set var dfont)))))))))
|
||||
(error
|
||||
(ignore-errors (doom-adjust-font-size nil))
|
||||
(signal (car e) (cdr e)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-font-exists-p (font)
|
||||
"Return non-nil if FONT exists on this system."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(ignore-errors (find-font (doom-normalize-font font))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/reload-font ()
|
||||
"Reload your fonts, if they're set.
|
||||
See `doom-init-fonts-h'."
|
||||
(interactive)
|
||||
(doom-init-fonts-h 'reload))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/increase-font-size (count &optional increment)
|
||||
"Enlargens the font size across the current and child frames."
|
||||
(interactive "p")
|
||||
(doom-adjust-font-size (* count (or increment doom-font-increment))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/decrease-font-size (count &optional increment)
|
||||
"Shrinks the font size across the current and child frames."
|
||||
(interactive "p")
|
||||
(doom-adjust-font-size (* (- count) (or increment doom-font-increment))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/reset-font-size ()
|
||||
"Reset font size and `text-scale'.
|
||||
|
||||
Assuming it has been adjusted via `doom/increase-font-size' and
|
||||
`doom/decrease-font-size', or `text-scale-*' commands."
|
||||
(interactive)
|
||||
(let (success)
|
||||
(when (and (boundp 'text-scale-mode-amount)
|
||||
(/= text-scale-mode-amount 0))
|
||||
(text-scale-set 0)
|
||||
(setq success t))
|
||||
(cond (doom-big-font-mode
|
||||
(message "Disabling `doom-big-font-mode'")
|
||||
(doom-big-font-mode -1)
|
||||
(setq success t))
|
||||
((doom-adjust-font-size nil)
|
||||
(setq success t)))
|
||||
(unless success
|
||||
(user-error "The font hasn't been resized"))))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode doom-big-font-mode
|
||||
"Globally resizes your fonts for streams, screen-sharing or presentations.
|
||||
|
||||
Uses `doom-big-font' if its set, otherwise uses `doom-font' (falling back to
|
||||
your system font).
|
||||
|
||||
Also resizees `doom-variable-pitch-font' and `doom-serif-font'."
|
||||
:init-value nil
|
||||
:lighter " BIG"
|
||||
:global t
|
||||
(if doom-big-font
|
||||
;; Use `doom-big-font' in lieu of `doom-font'
|
||||
(doom-adjust-font-size
|
||||
(when doom-big-font-mode
|
||||
(font-get (doom-normalize-font doom-big-font) :size))
|
||||
t `((doom-font . ,doom-big-font)))
|
||||
;; Resize the current font
|
||||
(doom-adjust-font-size (if doom-big-font-mode doom-big-font-increment))))
|
||||
752
lisp/lib/help.el
Normal file
752
lisp/lib/help.el
Normal file
|
|
@ -0,0 +1,752 @@
|
|||
;;; lisp/lib/help.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defvar doom--help-major-mode-module-alist
|
||||
'((dockerfile-mode :tools docker)
|
||||
(agda2-mode :lang agda)
|
||||
(c-mode :lang cc)
|
||||
(c++-mode :lang cc)
|
||||
(objc++-mode :lang cc)
|
||||
(crystal-mode :lang crystal)
|
||||
(lisp-mode :lang common-lisp)
|
||||
(csharp-mode :lang csharp)
|
||||
(clojure-mode :lang clojure)
|
||||
(clojurescript-mode :lang clojure)
|
||||
(json-mode :lang json)
|
||||
(yaml-mode :lang yaml)
|
||||
(csv-mode :lang data)
|
||||
(erlang-mode :lang erlang)
|
||||
(elixir-mode :lang elixir)
|
||||
(elm-mode :lang elm)
|
||||
(emacs-lisp-mode :lang emacs-lisp)
|
||||
(ess-r-mode :lang ess)
|
||||
(ess-julia-mode :lang ess)
|
||||
(go-mode :lang go)
|
||||
(haskell-mode :lang haskell)
|
||||
(hy-mode :lang hy)
|
||||
(idris-mode :lang idris)
|
||||
(java-mode :lang java)
|
||||
(js2-mode :lang javascript)
|
||||
(rjsx-mode :lang javascript)
|
||||
(typescript-mode :lang javascript)
|
||||
(typescript-tsx-mode :lang javascript)
|
||||
(coffee-mode :lang javascript)
|
||||
(julia-mode :lang julia)
|
||||
(kotlin-mode :lang kotlin)
|
||||
(latex-mode :lang latex)
|
||||
(LaTeX-mode :lang latex)
|
||||
(ledger-mode :lang ledger)
|
||||
(lua-mode :lang lua)
|
||||
(moonscript-mode :lang lua)
|
||||
(markdown-mode :lang markdown)
|
||||
(gfm-mode :lang markdown)
|
||||
(nim-mode :lang nim)
|
||||
(nix-mode :lang nix)
|
||||
(tuareg-mode :lang ocaml)
|
||||
(org-mode :lang org)
|
||||
(raku-mode :lang raku)
|
||||
(php-mode :lang php)
|
||||
(hack-mode :lang php)
|
||||
(plantuml-mode :lang plantuml)
|
||||
(purescript-mode :lang purescript)
|
||||
(python-mode :lang python)
|
||||
(restclient-mode :lang rest)
|
||||
(ruby-mode :lang ruby)
|
||||
(rust-mode :lang rust)
|
||||
(rustic-mode :lang rust)
|
||||
(scala-mode :lang scala)
|
||||
(scheme-mode :lang scheme)
|
||||
(sh-mode :lang sh)
|
||||
(swift-mode :lang swift)
|
||||
(web-mode :lang web)
|
||||
(css-mode :lang web)
|
||||
(scss-mode :lang web)
|
||||
(sass-mode :lang web)
|
||||
(less-css-mode :lang web)
|
||||
(stylus-mode :lang web)
|
||||
(terra-mode :lang terra))
|
||||
"An alist mapping major modes to Doom modules.
|
||||
|
||||
This is used by `doom/help-modules' to auto-select the module corresponding to
|
||||
the current major-modea.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-active-minor-modes ()
|
||||
"Return a list of active minor-mode symbols."
|
||||
(cl-loop for mode in minor-mode-list
|
||||
if (and (boundp mode) (symbol-value mode))
|
||||
collect mode))
|
||||
|
||||
|
||||
;;
|
||||
;;; Custom describe commands
|
||||
|
||||
;;;###autoload (defalias 'doom/describe-autodefs #'doom/help-autodefs)
|
||||
;;;###autoload (defalias 'doom/describe-module #'doom/help-modules)
|
||||
;;;###autoload (defalias 'doom/describe-package #'doom/help-packages)
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/describe-active-minor-mode (mode)
|
||||
"Get information on an active minor mode. Use `describe-minor-mode' for a
|
||||
selection of all minor-modes, active or not."
|
||||
(interactive
|
||||
(list (completing-read "Describe active mode: " (doom-active-minor-modes))))
|
||||
(let ((symbol
|
||||
(cond ((stringp mode) (intern mode))
|
||||
((symbolp mode) mode)
|
||||
((error "Expected a symbol/string, got a %s" (type-of mode))))))
|
||||
(if (fboundp symbol)
|
||||
(helpful-function symbol)
|
||||
(helpful-variable symbol))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Documentation commands
|
||||
|
||||
(defvar org-agenda-files)
|
||||
(cl-defun doom--org-headings (files &key depth mindepth include-files &allow-other-keys)
|
||||
"TODO"
|
||||
(require 'org)
|
||||
(let* ((default-directory doom-docs-dir)
|
||||
(org-agenda-files (mapcar #'expand-file-name (doom-enlist files)))
|
||||
(depth (if (integerp depth) depth))
|
||||
(mindepth (if (integerp mindepth) mindepth))
|
||||
(org-inhibit-startup t))
|
||||
(message "Loading search results...")
|
||||
(unwind-protect
|
||||
(delq
|
||||
nil
|
||||
(org-map-entries
|
||||
(lambda ()
|
||||
(cl-destructuring-bind (level _reduced-level _todo _priority text tags)
|
||||
(org-heading-components)
|
||||
(when (and (or (null depth)
|
||||
(<= level depth))
|
||||
(or (null mindepth)
|
||||
(>= level mindepth))
|
||||
(or (null tags)
|
||||
(not (string-match-p ":TOC" tags))))
|
||||
(let ((path (org-get-outline-path))
|
||||
(title (org-collect-keywords '("TITLE") '("TITLE"))))
|
||||
(list (string-join
|
||||
(list (string-join
|
||||
(append (when include-files
|
||||
(list (or (cdr (assoc "TITLE" title))
|
||||
(file-relative-name (buffer-file-name)))))
|
||||
path
|
||||
(when text
|
||||
(list (replace-regexp-in-string org-link-any-re "\\4" text))))
|
||||
" > ")
|
||||
tags)
|
||||
" ")
|
||||
(buffer-file-name)
|
||||
(point))))))
|
||||
t 'agenda))
|
||||
(mapc #'kill-buffer org-agenda-new-buffers)
|
||||
(setq org-agenda-new-buffers nil))))
|
||||
|
||||
(defvar ivy-sort-functions-alist)
|
||||
;;;###autoload
|
||||
(cl-defun doom-completing-read-org-headings
|
||||
(prompt files &rest plist &key depth mindepth include-files initial-input extra-candidates action)
|
||||
"TODO"
|
||||
(let ((alist
|
||||
(append (apply #'doom--org-headings files plist)
|
||||
extra-candidates))
|
||||
ivy-sort-functions-alist)
|
||||
(if-let (result (completing-read prompt alist nil nil initial-input))
|
||||
(cl-destructuring-bind (file &optional location)
|
||||
(cdr (assoc result alist))
|
||||
(if action
|
||||
(funcall action file location)
|
||||
(find-file file)
|
||||
(cond ((functionp location)
|
||||
(funcall location))
|
||||
(location
|
||||
(goto-char location)))
|
||||
(ignore-errors
|
||||
(when (outline-invisible-p)
|
||||
(save-excursion
|
||||
(outline-previous-visible-heading 1)
|
||||
(org-show-subtree))))))
|
||||
(user-error "Aborted"))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/homepage ()
|
||||
"Open the doom emacs homepage in the browser."
|
||||
(interactive)
|
||||
(browse-url "https://doomemacs.org"))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/issue-tracker ()
|
||||
"Open Doom Emacs' issue tracker on Discourse."
|
||||
(interactive)
|
||||
(browse-url "https://github.com/hlissner/doom-emacs/issues"))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/report-bug ()
|
||||
"Open the browser on our Discourse.
|
||||
|
||||
If called when a backtrace buffer is present, it and the output of `doom-info'
|
||||
will be automatically appended to the result."
|
||||
(interactive)
|
||||
;; TODO Upload doom/info to pastebin and append to querystring
|
||||
(browse-url "https://github.com/hlissner/doom-emacs/issues/new?labels=1.+bug%2C2.+status%3Aunread&template=bug_report.yml"))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/discourse ()
|
||||
"Open Doom Emacs' issue tracker on Discourse."
|
||||
(interactive)
|
||||
(browse-url "https://discourse.doomemacs.org"))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help ()
|
||||
"Open Doom's user manual."
|
||||
(interactive)
|
||||
(find-file (expand-file-name "index.org" doom-docs-dir)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-search-headings (&optional initial-input)
|
||||
"Search Doom's documentation and jump to a headline."
|
||||
(interactive)
|
||||
(doom-completing-read-org-headings
|
||||
"Find in Doom help: "
|
||||
(list "getting_started.org"
|
||||
"contributing.org"
|
||||
"troubleshooting.org"
|
||||
"tutorials.org"
|
||||
"faq.org")
|
||||
:depth 3
|
||||
:include-files t
|
||||
:initial-input initial-input
|
||||
:extra-candidates
|
||||
(mapcar (lambda (x)
|
||||
(setcar x (concat "Doom Modules > " (car x)))
|
||||
x)
|
||||
(doom--help-modules-list))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-search (&optional initial-input)
|
||||
"Perform a text search on all of Doom's documentation."
|
||||
(interactive)
|
||||
(funcall (cond ((fboundp '+ivy-file-search)
|
||||
#'+ivy-file-search)
|
||||
((fboundp '+helm-file-search)
|
||||
#'+helm-file-search)
|
||||
((fboundp '+vertico-file-search)
|
||||
#'+vertico-file-search)
|
||||
((rgrep
|
||||
(read-regexp
|
||||
"Search for" (or initial-input 'grep-tag-default)
|
||||
'grep-regexp-history)
|
||||
"*.org" doom-emacs-dir)
|
||||
#'ignore))
|
||||
:query initial-input
|
||||
:args '("-t" "org")
|
||||
:in doom-emacs-dir
|
||||
:prompt "Search documentation for: "))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-search-news (&optional initial-input)
|
||||
"Search headlines in Doom's newsletters."
|
||||
(interactive)
|
||||
(doom-completing-read-org-headings
|
||||
"Find in News: "
|
||||
(nreverse (doom-files-in (expand-file-name "news" doom-docs-dir)
|
||||
:match "/[0-9]"
|
||||
:relative-to doom-docs-dir))
|
||||
:include-files t
|
||||
:initial-input initial-input))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-faq (&optional initial-input)
|
||||
"Search Doom's FAQ and jump to a question."
|
||||
(interactive)
|
||||
(doom-completing-read-org-headings
|
||||
"Find in FAQ: " (list "faq.org")
|
||||
:depth 2
|
||||
:initial-input initial-input))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-news ()
|
||||
"Open a Doom newsletter.
|
||||
The latest newsletter will be selected by default."
|
||||
(interactive)
|
||||
(let* ((default-directory (expand-file-name "news/" doom-docs-dir))
|
||||
(news-files (doom-files-in default-directory)))
|
||||
(find-file
|
||||
(read-file-name (format "Open Doom newsletter (current: v%s): "
|
||||
doom-version)
|
||||
default-directory
|
||||
(if (member doom-version news-files)
|
||||
doom-version
|
||||
(concat (mapconcat #'number-to-string
|
||||
(nbutlast (version-to-list doom-version) 1)
|
||||
".")
|
||||
".x"))
|
||||
t doom-version))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-autodefs (autodef)
|
||||
"Open documentation for an autodef.
|
||||
|
||||
An autodef is a Doom concept. It is a function or macro that is always defined,
|
||||
whether or not its containing module is disabled (in which case it will safely
|
||||
no-op without evaluating its arguments). This syntactic sugar lets you use them
|
||||
without needing to check if they are available."
|
||||
(interactive
|
||||
(let* ((settings
|
||||
(cl-loop with case-fold-search = nil
|
||||
for sym being the symbols of obarray
|
||||
for sym-name = (symbol-name sym)
|
||||
if (and (or (functionp sym)
|
||||
(macrop sym))
|
||||
(string-match-p "[a-z]!$" sym-name))
|
||||
collect sym))
|
||||
(sym (symbol-at-point))
|
||||
(autodef
|
||||
(completing-read
|
||||
"Describe setter: "
|
||||
;; TODO Could be cleaner (refactor me!)
|
||||
(cl-loop with maxwidth = (apply #'max (mapcar #'length (mapcar #'symbol-name settings)))
|
||||
for def in (sort settings #'string-lessp)
|
||||
if (get def 'doom-module)
|
||||
collect
|
||||
(format (format "%%-%ds%%s" (+ maxwidth 4))
|
||||
def (propertize (format "%s %s" (car it) (cdr it))
|
||||
'face 'font-lock-comment-face))
|
||||
else if (and (string-match-p "^set-.+!$" (symbol-name def))
|
||||
(symbol-file def)
|
||||
(file-in-directory-p (symbol-file def) doom-core-dir))
|
||||
collect
|
||||
(format (format "%%-%ds%%s" (+ maxwidth 4))
|
||||
def (propertize (format "lisp/%s.el" (file-name-sans-extension (file-relative-name (symbol-file def) doom-core-dir)))
|
||||
'face 'font-lock-comment-face)))
|
||||
nil t
|
||||
(when (and (symbolp sym)
|
||||
(string-match-p "!$" (symbol-name sym)))
|
||||
(symbol-name sym)))))
|
||||
(list (and autodef (car (split-string autodef " "))))))
|
||||
(or (stringp autodef)
|
||||
(functionp autodef)
|
||||
(signal 'wrong-type-argument (list '(stringp functionp) autodef)))
|
||||
(let ((fn (if (functionp autodef)
|
||||
autodef
|
||||
(intern-soft autodef))))
|
||||
(or (fboundp fn)
|
||||
(error "'%s' is not a valid DOOM autodef" autodef))
|
||||
(if (fboundp 'helpful-callable)
|
||||
(helpful-callable fn)
|
||||
(describe-function fn))))
|
||||
|
||||
(defun doom--help-modules-list ()
|
||||
(cl-loop for path in (cdr (doom-module-load-path 'all))
|
||||
for (cat . mod) = (doom-module-from-path path)
|
||||
for readme-path = (or (doom-module-locate-path cat mod "README.org")
|
||||
(doom-module-locate-path cat mod))
|
||||
for format = (format "%s %s" cat mod)
|
||||
if (doom-module-p cat mod)
|
||||
collect (list format readme-path)
|
||||
else if (and cat mod)
|
||||
collect (list (propertize format 'face 'font-lock-comment-face)
|
||||
readme-path)))
|
||||
|
||||
(defun doom--help-current-module-str ()
|
||||
(cond ((save-excursion
|
||||
(require 'smartparens)
|
||||
(ignore-errors
|
||||
(sp-beginning-of-sexp)
|
||||
(unless (eq (char-after) ?\()
|
||||
(backward-char))
|
||||
(let ((sexp (sexp-at-point)))
|
||||
(when (memq (car-safe sexp) '(featurep! require!))
|
||||
(format "%s %s" (nth 1 sexp) (nth 2 sexp)))))))
|
||||
((when buffer-file-name
|
||||
(when-let (mod (doom-module-from-path buffer-file-name))
|
||||
(unless (memq (car mod) '(:core :private))
|
||||
(format "%s %s" (car mod) (cdr mod))))))
|
||||
((when-let (mod (cdr (assq major-mode doom--help-major-mode-module-alist)))
|
||||
(format "%s %s"
|
||||
(symbol-name (car mod))
|
||||
(symbol-name (cadr mod)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-modules (category module &optional visit-dir)
|
||||
"Open the documentation for a Doom module.
|
||||
|
||||
CATEGORY is a keyword and MODULE is a symbol. e.g. :editor and 'evil.
|
||||
|
||||
If VISIT-DIR is non-nil, visit the module's directory rather than its
|
||||
documentation.
|
||||
|
||||
Automatically selects a) the module at point (in private init files), b) the
|
||||
module derived from a `featurep!' or `require!' call, c) the module that the
|
||||
current file is in, or d) the module associated with the current major mode (see
|
||||
`doom--help-major-mode-module-alist')."
|
||||
(interactive
|
||||
(nconc
|
||||
(mapcar #'intern
|
||||
(split-string
|
||||
(completing-read "Describe module: "
|
||||
(doom--help-modules-list)
|
||||
nil t nil nil
|
||||
(doom--help-current-module-str))
|
||||
" " t))
|
||||
(list current-prefix-arg)))
|
||||
(cl-check-type category symbol)
|
||||
(cl-check-type module symbol)
|
||||
(cl-destructuring-bind (module-string path)
|
||||
(or (assoc (format "%s %s" category module) (doom--help-modules-list))
|
||||
(user-error "'%s %s' is not a valid module" category module))
|
||||
(setq module-string (substring-no-properties module-string))
|
||||
(unless (file-readable-p path)
|
||||
(error "Can't find or read %S module at %S" module-string path))
|
||||
(cond ((not (file-directory-p path))
|
||||
(if visit-dir
|
||||
(doom-project-browse (file-name-directory path))
|
||||
(find-file path)))
|
||||
(visit-dir
|
||||
(doom-project-browse path))
|
||||
((y-or-n-p (format "The %S module has no README file. Explore its directory?"
|
||||
module-string))
|
||||
(doom-project-browse (file-name-directory path)))
|
||||
((user-error "Aborted module lookup")))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-custom-variable (var)
|
||||
"Look up documentation for a custom variable.
|
||||
|
||||
Unlike `helpful-variable', which casts a wider net that includes internal
|
||||
variables, this only lists variables that exist to be customized (defined with
|
||||
`defcustom')."
|
||||
(interactive
|
||||
(list (helpful--read-symbol
|
||||
"Custom variable: "
|
||||
(helpful--variable-at-point)
|
||||
(lambda (sym)
|
||||
(and (helpful--variable-p sym)
|
||||
(custom-variable-p sym)
|
||||
;; Exclude minor mode state variables, which aren't meant to be
|
||||
;; modified directly, but through their associated function.
|
||||
(not (or (and (string-suffix-p "-mode" (symbol-name sym))
|
||||
(fboundp sym))
|
||||
(eq (get sym 'custom-set) 'custom-set-minor-mode))))))))
|
||||
(helpful-variable var))
|
||||
|
||||
|
||||
;;
|
||||
;;; `doom/help-packages'
|
||||
|
||||
(defun doom--help-insert-button (label &optional uri line)
|
||||
"Helper function to insert a button at point.
|
||||
|
||||
The button will have the text LABEL. If URI is given, the button will open it,
|
||||
otherwise the LABEL will be used. If the uri to open is a url it will be opened
|
||||
in a browser. If LINE is given (and the uri to open is not a url), then the file
|
||||
will open with point on that line."
|
||||
(let ((uri (or uri label)))
|
||||
(insert-text-button
|
||||
label
|
||||
'face 'link
|
||||
'follow-link t
|
||||
'action
|
||||
(if (string-match-p "^https?://" uri)
|
||||
(lambda (_) (browse-url uri))
|
||||
(unless (file-exists-p uri)
|
||||
(error "Path does not exist: %S" uri))
|
||||
(lambda (_)
|
||||
(when (window-dedicated-p)
|
||||
(other-window 1))
|
||||
(find-file uri)
|
||||
(when line
|
||||
(goto-char (point-min))
|
||||
(forward-line (1- line))
|
||||
(recenter)))))))
|
||||
|
||||
(defun doom--help-package-configs (package)
|
||||
(let ((default-directory doom-emacs-dir))
|
||||
;; TODO Use ripgrep instead
|
||||
(split-string
|
||||
(cdr (doom-call-process
|
||||
"git" "grep" "--no-break" "--no-heading" "--line-number"
|
||||
(format "%s %s\\($\\| \\)"
|
||||
"\\(^;;;###package\\|(after!\\|(use-package!\\)"
|
||||
package)
|
||||
":(exclude)*.org"))
|
||||
"\n" t)))
|
||||
|
||||
(defvar doom--help-packages-list nil)
|
||||
;;;###autoload
|
||||
(defun doom/help-packages (package)
|
||||
"Like `describe-package', but for packages installed by Doom modules.
|
||||
|
||||
Only shows installed packages. Includes information about where packages are
|
||||
defined and configured.
|
||||
|
||||
If prefix arg is present, refresh the cache."
|
||||
(interactive
|
||||
(let ((guess (or (function-called-at-point)
|
||||
(symbol-at-point))))
|
||||
(require 'finder-inf nil t)
|
||||
(require 'package)
|
||||
(require 'straight)
|
||||
(let ((packages
|
||||
(if (and doom--help-packages-list (null current-prefix-arg))
|
||||
doom--help-packages-list
|
||||
(message "Generating packages list for the first time...")
|
||||
(redisplay)
|
||||
(setq doom--help-packages-list
|
||||
(delete-dups
|
||||
(append (mapcar #'car package-alist)
|
||||
(mapcar #'car package--builtins)
|
||||
(mapcar #'intern
|
||||
(hash-table-keys straight--build-cache))
|
||||
(mapcar #'car (doom-package-list 'all))
|
||||
nil))))))
|
||||
(unless (memq guess packages)
|
||||
(setq guess nil))
|
||||
(list
|
||||
(intern
|
||||
(completing-read (format "Describe Doom package (%s): "
|
||||
(concat (when guess
|
||||
(format "default '%s', " guess))
|
||||
(format "total %d" (length packages))))
|
||||
packages nil t nil nil
|
||||
(when guess (symbol-name guess))))))))
|
||||
;; TODO Refactor me.
|
||||
(require 'doom-packages)
|
||||
(doom-initialize-packages)
|
||||
(help-setup-xref (list #'doom/help-packages package)
|
||||
(called-interactively-p 'interactive))
|
||||
(with-help-window (help-buffer)
|
||||
(with-current-buffer standard-output
|
||||
(when (or (package-desc-p package)
|
||||
(and (symbolp package)
|
||||
(or (assq package package-alist)
|
||||
(assq package package--builtins))))
|
||||
(describe-package-1 package))
|
||||
(let ((indent (make-string 13 ? )))
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward " Status: .*$" nil t)
|
||||
(insert "\n")
|
||||
(search-forward "\n\n" nil t))
|
||||
|
||||
(package--print-help-section "Package")
|
||||
(insert (symbol-name package) "\n")
|
||||
|
||||
(package--print-help-section "Source")
|
||||
(pcase (doom-package-backend package)
|
||||
(`straight
|
||||
(insert "Straight\n")
|
||||
(package--print-help-section "Pinned")
|
||||
(insert (if-let (pin (plist-get (cdr (assq package doom-packages)) :pin))
|
||||
pin
|
||||
"unpinned")
|
||||
"\n")
|
||||
|
||||
(package--print-help-section "Build")
|
||||
(let ((default-directory (straight--repos-dir (symbol-name package))))
|
||||
(if (file-exists-p default-directory)
|
||||
(insert (cdr (doom-call-process "git" "log" "-1" "--format=%D %h %ci")))
|
||||
(insert "n/a")))
|
||||
(insert "\n" indent)
|
||||
|
||||
(package--print-help-section "Build location")
|
||||
(let ((build-dir (straight--build-dir (symbol-name package))))
|
||||
(if (file-exists-p build-dir)
|
||||
(doom--help-insert-button (abbreviate-file-name build-dir))
|
||||
(insert "n/a")))
|
||||
(insert "\n" indent)
|
||||
|
||||
(package--print-help-section "Repo location")
|
||||
(let* ((local-repo (doom-package-recipe-repo package))
|
||||
(repo-dir (straight--repos-dir local-repo)))
|
||||
(if (file-exists-p repo-dir)
|
||||
(doom--help-insert-button (abbreviate-file-name repo-dir))
|
||||
(insert "n/a"))
|
||||
(insert "\n"))
|
||||
|
||||
(let ((recipe (doom-package-build-recipe package)))
|
||||
(package--print-help-section "Recipe")
|
||||
(insert
|
||||
(replace-regexp-in-string "\n" (concat "\n" indent)
|
||||
(pp-to-string recipe))))
|
||||
|
||||
(package--print-help-section "Homepage")
|
||||
(doom--help-insert-button (doom-package-homepage package)))
|
||||
|
||||
(`elpa (insert "[M]ELPA ")
|
||||
(doom--help-insert-button (doom-package-homepage package))
|
||||
(package--print-help-section "Location")
|
||||
(doom--help-insert-button
|
||||
(abbreviate-file-name
|
||||
(file-name-directory
|
||||
(locate-library (symbol-name package))))))
|
||||
(`builtin (insert "Built-in\n")
|
||||
(package--print-help-section "Location")
|
||||
(doom--help-insert-button
|
||||
(abbreviate-file-name
|
||||
(file-name-directory
|
||||
(locate-library (symbol-name package))))))
|
||||
(`other (doom--help-insert-button
|
||||
(abbreviate-file-name
|
||||
(or (symbol-file package)
|
||||
(locate-library (symbol-name package))))))
|
||||
(_ (insert "Not installed")))
|
||||
(insert "\n")
|
||||
|
||||
(when-let
|
||||
(modules
|
||||
(if (gethash (symbol-name package) straight--build-cache)
|
||||
(doom-package-get package :modules)
|
||||
(plist-get (cdr (assq package (doom-package-list 'all)))
|
||||
:modules)))
|
||||
(package--print-help-section "Modules")
|
||||
(insert "Declared by the following Doom modules:\n")
|
||||
(dolist (m modules)
|
||||
(let* ((module-path (pcase (car m)
|
||||
(:core doom-core-dir)
|
||||
(:private doom-private-dir)
|
||||
(category
|
||||
(doom-module-locate-path category
|
||||
(cdr m)))))
|
||||
(readme-path (expand-file-name "README.org" module-path)))
|
||||
(insert indent)
|
||||
(doom--help-insert-button
|
||||
(format "%s %s" (car m) (or (cdr m) ""))
|
||||
module-path)
|
||||
(insert " (")
|
||||
(if (file-exists-p readme-path)
|
||||
(doom--help-insert-button "readme" readme-path)
|
||||
(insert "no readme"))
|
||||
(insert ")\n"))))
|
||||
|
||||
(package--print-help-section "Configs")
|
||||
(if-let ((configs (doom--help-package-configs package)))
|
||||
(progn
|
||||
(insert "This package is configured in the following locations:")
|
||||
(dolist (location configs)
|
||||
(insert "\n" indent)
|
||||
(cl-destructuring-bind (file line _match &rest)
|
||||
(split-string location ":")
|
||||
(doom--help-insert-button location
|
||||
(expand-file-name file doom-emacs-dir)
|
||||
(string-to-number line)))))
|
||||
(insert "This package is not configured anywhere"))
|
||||
(goto-char (point-min))))))
|
||||
|
||||
(defvar doom--package-cache nil)
|
||||
(defun doom--package-list (&optional prompt)
|
||||
(let* ((guess (or (function-called-at-point)
|
||||
(symbol-at-point))))
|
||||
(require 'finder-inf nil t)
|
||||
(unless package--initialized
|
||||
(package-initialize t))
|
||||
(let ((packages (or doom--package-cache
|
||||
(progn
|
||||
(message "Reading packages...")
|
||||
(cl-delete-duplicates
|
||||
(append (mapcar 'car package-alist)
|
||||
(mapcar 'car package--builtins)
|
||||
(mapcar 'car package-archive-contents)))))))
|
||||
(setq doom--package-cache packages)
|
||||
(unless (memq guess packages)
|
||||
(setq guess nil))
|
||||
(intern (completing-read (or prompt
|
||||
(if guess
|
||||
(format "Select package to search for (default %s): "
|
||||
guess)
|
||||
"Describe package: "))
|
||||
packages nil t nil nil
|
||||
(if guess (symbol-name guess)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-package-config (package)
|
||||
"Jump to any `use-package!', `after!' or ;;;###package block for PACKAGE.
|
||||
|
||||
This only searches `doom-emacs-dir' (typically ~/.emacs.d) and does not include
|
||||
config blocks in your private config."
|
||||
(interactive (list (doom--package-list "Find package config: ")))
|
||||
(cl-destructuring-bind (file line _match)
|
||||
(split-string
|
||||
(completing-read
|
||||
"Jump to config: "
|
||||
(or (doom--help-package-configs package)
|
||||
(user-error "This package isn't configured by you or Doom")))
|
||||
":")
|
||||
(find-file (expand-file-name file doom-emacs-dir))
|
||||
(goto-char (point-min))
|
||||
(forward-line (1- line))
|
||||
(recenter)))
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'doom/help-package-homepage #'straight-visit-package-website)
|
||||
|
||||
(defun doom--help-search-prompt (prompt)
|
||||
(let ((query (doom-thing-at-point-or-region)))
|
||||
(if (featurep 'counsel)
|
||||
query
|
||||
(read-string prompt query 'git-grep query))))
|
||||
|
||||
(defvar counsel-rg-base-command)
|
||||
(defun doom--help-search (dirs query prompt)
|
||||
;; REVIEW Replace with deadgrep
|
||||
(unless (executable-find "rg")
|
||||
(user-error "Can't find ripgrep on your system"))
|
||||
(cond ((fboundp 'consult--grep)
|
||||
(consult--grep
|
||||
prompt
|
||||
(lambda (input)
|
||||
(pcase-let* ((cmd (split-string-and-unquote consult-ripgrep-args))
|
||||
(type (consult--ripgrep-regexp-type (car cmd)))
|
||||
(`(,arg . ,opts) (consult--command-split input))
|
||||
(`(,re . ,hl) (funcall consult--regexp-compiler arg type)))
|
||||
(when re
|
||||
(list :command
|
||||
(append cmd
|
||||
(and (eq type 'pcre) '("-P"))
|
||||
(list "-e" (consult--join-regexps re type))
|
||||
opts
|
||||
dirs)
|
||||
:highlight hl))))
|
||||
data-directory query))
|
||||
((fboundp 'counsel-rg)
|
||||
(let ((counsel-rg-base-command
|
||||
(if (stringp counsel-rg-base-command)
|
||||
(format counsel-rg-base-command
|
||||
(concat "%s " (mapconcat #'shell-quote-argument dirs " ")))
|
||||
(append counsel-rg-base-command dirs))))
|
||||
(counsel-rg query nil "-Lz" (concat prompt ": "))))
|
||||
;; () TODO Helm support?
|
||||
((grep-find
|
||||
(string-join
|
||||
(append (list "rg" "-L" "--search-zip" "--no-heading" "--color=never"
|
||||
(shell-quote-argument query))
|
||||
(mapcar #'shell-quote-argument dirs))
|
||||
" ")))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-search-load-path (query)
|
||||
"Perform a text search on your `load-path'.
|
||||
Uses the symbol at point or the current selection, if available."
|
||||
(interactive
|
||||
(list (doom--help-search-prompt "Search load-path: ")))
|
||||
(doom--help-search (cl-remove-if-not #'file-directory-p load-path)
|
||||
query "Search load-path: "))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-search-loaded-files (query)
|
||||
"Perform a text search on your `load-path'.
|
||||
Uses the symbol at point or the current selection, if available."
|
||||
(interactive
|
||||
(list (doom--help-search-prompt "Search loaded files: ")))
|
||||
(doom--help-search
|
||||
(cl-loop for (file . _) in (cl-remove-if-not #'stringp load-history :key #'car)
|
||||
for filebase = (file-name-sans-extension file)
|
||||
if (file-exists-p! (or (format "%s.el.gz" filebase)
|
||||
(format "%s.el" filebase)))
|
||||
collect it)
|
||||
query "Search loaded files: "))
|
||||
307
lisp/lib/packages.el
Normal file
307
lisp/lib/packages.el
Normal file
|
|
@ -0,0 +1,307 @@
|
|||
;;; lisp/lib/packages.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/reload-packages ()
|
||||
"Reload `doom-packages', `package' and `quelpa'."
|
||||
(interactive)
|
||||
;; HACK straight.el must be loaded for this to work
|
||||
(message "Reloading packages")
|
||||
(doom-initialize-packages t)
|
||||
(message "Reloading packages...DONE"))
|
||||
|
||||
|
||||
;;
|
||||
;;; Bump commands
|
||||
|
||||
(defun doom--package-merge-recipes (package plist)
|
||||
(require 'straight)
|
||||
(doom-plist-merge
|
||||
(plist-get plist :recipe)
|
||||
(if-let (recipe (straight-recipes-retrieve package))
|
||||
(cdr (if (memq (car recipe) '(quote \`))
|
||||
(eval recipe t)
|
||||
recipe))
|
||||
(let ((recipe (plist-get (cdr (assq package doom-packages))
|
||||
:recipe)))
|
||||
(if (keywordp (car recipe))
|
||||
recipe
|
||||
(cdr recipe))))))
|
||||
|
||||
(defun doom--package-to-bump-string (package plist)
|
||||
"Return a PACKAGE and its PLIST in 'username/repo@commit' format."
|
||||
(format "%s@%s"
|
||||
(plist-get (doom--package-merge-recipes package plist) :repo)
|
||||
(substring-no-properties (plist-get plist :pin) 0 12)))
|
||||
|
||||
(defun doom--package-at-point (&optional point)
|
||||
"Return the package and plist from the (package! PACKAGE PLIST...) at point."
|
||||
(save-match-data
|
||||
(save-excursion
|
||||
(and point (goto-char point))
|
||||
(while (and (or (atom (sexp-at-point))
|
||||
(doom-point-in-string-or-comment-p))
|
||||
(search-backward "(" nil t)))
|
||||
(when (eq (car-safe (sexp-at-point)) 'package!)
|
||||
(cl-destructuring-bind (beg . end)
|
||||
(bounds-of-thing-at-point 'sexp)
|
||||
(let* ((doom-packages nil)
|
||||
(buffer-file-name
|
||||
(or buffer-file-name
|
||||
(bound-and-true-p org-src-source-file-name)))
|
||||
(package (eval (sexp-at-point) t)))
|
||||
(list :beg beg
|
||||
:end end
|
||||
:package (car package)
|
||||
:plist (cdr package))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/bumpify-package-at-point ()
|
||||
"Convert `package!' call at point to a bump string."
|
||||
(interactive)
|
||||
(cl-destructuring-bind (&key package plist beg end)
|
||||
(doom--package-at-point)
|
||||
(when-let (str (doom--package-to-bump-string package plist))
|
||||
(goto-char beg)
|
||||
(delete-region beg end)
|
||||
(insert str))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/bumpify-packages-in-buffer ()
|
||||
"Convert all `package!' calls in buffer into bump strings."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "(package!" nil t)
|
||||
(unless (doom-point-in-string-or-comment-p)
|
||||
(doom/bumpify-package-at-point)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/bump-package-at-point (&optional select)
|
||||
"Inserts or updates a `:pin' for the `package!' statement at point.
|
||||
Grabs the latest commit id of the package using 'git'."
|
||||
(interactive "P")
|
||||
(doom-initialize-packages)
|
||||
(cl-destructuring-bind (&key package plist beg end)
|
||||
(or (doom--package-at-point)
|
||||
(user-error "Not on a `package!' call"))
|
||||
(let* ((recipe (doom--package-merge-recipes package plist))
|
||||
(branch (plist-get recipe :branch))
|
||||
(oldid (or (plist-get plist :pin)
|
||||
(doom-package-get package :pin)))
|
||||
(url (straight-vc-git--destructure recipe (upstream-repo upstream-host)
|
||||
(straight-vc-git--encode-url upstream-repo upstream-host)))
|
||||
(id (or (when url
|
||||
(cdr (doom-call-process
|
||||
"git" "ls-remote" url
|
||||
(unless select branch))))
|
||||
(user-error "Couldn't find a recipe for %s" package)))
|
||||
(id (car (split-string
|
||||
(if select
|
||||
(completing-read "Commit: " (split-string id "\n" t))
|
||||
id)))))
|
||||
(when (and oldid
|
||||
(plist-member plist :pin)
|
||||
(equal oldid id))
|
||||
(user-error "%s: no update necessary" package))
|
||||
(save-excursion
|
||||
(if (re-search-forward ":pin +\"\\([^\"]+\\)\"" end t)
|
||||
(replace-match id t t nil 1)
|
||||
(goto-char (1- end))
|
||||
(insert " :pin " (prin1-to-string id))))
|
||||
(cond ((not oldid)
|
||||
(message "%s: → %s" package (substring id 0 10)))
|
||||
((< (length oldid) (length id))
|
||||
(message "%s: extended to %s..." package id))
|
||||
((message "%s: %s → %s"
|
||||
package
|
||||
(substring oldid 0 10)
|
||||
(substring id 0 10)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/bump-packages-in-buffer (&optional select)
|
||||
"Inserts or updates a `:pin' to all `package!' statements in current buffer.
|
||||
If SELECT (prefix arg) is non-nil, prompt you to choose a specific commit for
|
||||
each package."
|
||||
(interactive "P")
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(doom-initialize-packages)
|
||||
(let (packages)
|
||||
(while (search-forward "(package! " nil t)
|
||||
(unless (let ((ppss (syntax-ppss)))
|
||||
(or (nth 4 ppss)
|
||||
(nth 3 ppss)
|
||||
(save-excursion
|
||||
(and (goto-char (match-beginning 0))
|
||||
(not (plist-member (sexp-at-point) :pin))))))
|
||||
(condition-case e
|
||||
(push (doom/bump-package-at-point select) packages)
|
||||
(user-error (message "%s" (error-message-string e))))))
|
||||
(if packages
|
||||
(message "Updated %d packages\n- %s" (length packages) (string-join packages "\n- "))
|
||||
(message "No packages to update")))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/bump-module (category &optional module select)
|
||||
"Bump packages in CATEGORY MODULE.
|
||||
If SELECT (prefix arg) is non-nil, prompt you to choose a specific commit for
|
||||
each package."
|
||||
(interactive
|
||||
(let* ((module (completing-read
|
||||
"Bump module: "
|
||||
(let ((modules (doom-module-list 'all)))
|
||||
(mapcar (lambda (m)
|
||||
(if (listp m)
|
||||
(format "%s %s" (car m) (cdr m))
|
||||
(format "%s" m)))
|
||||
(append '(:private :core)
|
||||
(delete-dups (mapcar #'car modules))
|
||||
modules)))
|
||||
nil t nil nil))
|
||||
(module (split-string module " " t)))
|
||||
(list (intern (car module))
|
||||
(ignore-errors (intern (cadr module)))
|
||||
current-prefix-arg)))
|
||||
(mapc (lambda! ((cat . mod))
|
||||
(if-let (packages-file
|
||||
(pcase cat
|
||||
(:private (car (doom-glob doom-private-dir "packages.el")))
|
||||
(:core (car (doom-glob doom-core-dir "packages.el")))
|
||||
(_ (doom-module-locate-path cat mod "packages.el"))))
|
||||
(with-current-buffer
|
||||
(or (get-file-buffer packages-file)
|
||||
(find-file-noselect packages-file))
|
||||
(doom/bump-packages-in-buffer select)
|
||||
(save-buffer))
|
||||
(message "Module %s has no packages.el file" (cons cat mod))))
|
||||
(if module
|
||||
(list (cons category module))
|
||||
(cl-remove-if-not (lambda (m) (eq (car m) category))
|
||||
(append '((:core) (:private))
|
||||
(doom-module-list 'all))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/bump-package (package)
|
||||
"Bump PACKAGE in all modules that install it."
|
||||
(interactive
|
||||
(list (intern (completing-read "Bump package: "
|
||||
(mapcar #'car (doom-package-list 'all))))))
|
||||
(let* ((packages (doom-package-list 'all))
|
||||
(modules (plist-get (alist-get package packages) :modules)))
|
||||
(unless modules
|
||||
(user-error "This package isn't installed by any Doom module"))
|
||||
(dolist (module modules)
|
||||
(when-let (packages-file (doom-module-locate-path (car module) (cdr module)))
|
||||
(doom/bump-module (car module) (cdr module))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Bump commits
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/bumpify-diff (&optional interactive)
|
||||
"Copy user/repo@hash -> user/repo@hash's of changed packages to clipboard.
|
||||
|
||||
Must be run from a magit diff buffer."
|
||||
(interactive (list 'interactive))
|
||||
(save-window-excursion
|
||||
(magit-diff-staged)
|
||||
(unless (eq major-mode 'magit-diff-mode)
|
||||
(user-error "Not in a magit diff buffer"))
|
||||
(goto-char (point-min))
|
||||
(let (targets lines)
|
||||
(save-excursion
|
||||
(while (re-search-forward "^modified +\\(.+\\)$" nil t)
|
||||
(cl-pushnew (doom-module-from-path (match-string 1)) targets
|
||||
:test #'equal)))
|
||||
(while (re-search-forward "^-" nil t)
|
||||
(let ((file (magit-file-at-point))
|
||||
before after)
|
||||
(and (save-window-excursion
|
||||
(call-interactively #'magit-diff-visit-file)
|
||||
(when (or (looking-at-p "(package!")
|
||||
(re-search-forward "(package! " (line-end-position) t)
|
||||
(re-search-backward "(package! " nil t))
|
||||
(let ((buffer-file-name file))
|
||||
(cl-destructuring-bind (&key package plist _beg _end)
|
||||
(doom--package-at-point)
|
||||
(setq before (doom--package-to-bump-string package plist))))))
|
||||
(re-search-forward "^+" nil t)
|
||||
(save-window-excursion
|
||||
(call-interactively #'magit-diff-visit-file)
|
||||
(or (looking-at-p "(package!")
|
||||
(re-search-forward "(package! " (line-end-position) t)
|
||||
(re-search-backward "(package! "))
|
||||
(let ((buffer-file-name file))
|
||||
(cl-destructuring-bind (&key package plist _beg _end)
|
||||
(doom--package-at-point)
|
||||
(setq after (doom--package-to-bump-string package plist)))))
|
||||
(cl-pushnew (format "%s -> %s" before after) lines))))
|
||||
(if (null lines)
|
||||
(user-error "No bumps to bumpify")
|
||||
(prog1 (funcall (if interactive #'kill-new #'identity)
|
||||
(format "bump: %s\n\n%s"
|
||||
(mapconcat (lambda (x)
|
||||
(mapconcat #'symbol-name x " "))
|
||||
(cl-loop with alist = ()
|
||||
for (category . module) in (reverse targets)
|
||||
do (setf (alist-get category alist)
|
||||
(append (alist-get category alist) (list module)))
|
||||
finally return alist)
|
||||
" ")
|
||||
(string-join (sort (reverse lines) #'string-lessp)
|
||||
"\n")))
|
||||
(when interactive
|
||||
(message "Copied to clipboard")))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/commit-bumps ()
|
||||
"Create a pre-filled magit commit for currently bumped packages."
|
||||
(interactive)
|
||||
(magit-commit-create
|
||||
(list "-e" "-m" (doom/bumpify-diff))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Package metadata
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-package-homepage (package)
|
||||
"Return the url to PACKAGE's homepage (usually a repo)."
|
||||
(doom-initialize-packages)
|
||||
(or (get package 'homepage)
|
||||
(put package 'homepage
|
||||
(cond ((when-let (location (locate-library (symbol-name package)))
|
||||
(with-temp-buffer
|
||||
(if (string-match-p "\\.gz$" location)
|
||||
(jka-compr-insert-file-contents location)
|
||||
(insert-file-contents (concat (file-name-sans-extension location) ".el")
|
||||
nil 0 4096))
|
||||
(let ((case-fold-search t))
|
||||
(when (re-search-forward " \\(?:URL\\|homepage\\|Website\\): \\(http[^\n]+\\)\n" nil t)
|
||||
(match-string-no-properties 1))))))
|
||||
((when-let ((recipe (straight-recipes-retrieve package)))
|
||||
(straight--with-plist (straight--convert-recipe recipe)
|
||||
(host repo)
|
||||
(pcase host
|
||||
(`github (format "https://github.com/%s" repo))
|
||||
(`gitlab (format "https://gitlab.com/%s" repo))
|
||||
(`bitbucket (format "https://bitbucket.com/%s" (plist-get plist :repo)))
|
||||
(`git repo)
|
||||
(_ nil)))))
|
||||
((or package-archive-contents
|
||||
(progn (package-refresh-contents)
|
||||
package-archive-contents))
|
||||
(pcase (ignore-errors (package-desc-archive (cadr (assq package package-archive-contents))))
|
||||
(`nil nil)
|
||||
("org" "https://orgmode.org")
|
||||
((or "melpa" "melpa-mirror")
|
||||
(format "https://melpa.org/#/%s" package))
|
||||
("gnu"
|
||||
(format "https://elpa.gnu.org/packages/%s.html" package))
|
||||
(archive
|
||||
(if-let (src (cdr (assoc package package-archives)))
|
||||
(format "%s" src)
|
||||
(user-error "%S isn't installed through any known source (%s)"
|
||||
package archive)))))
|
||||
((user-error "Can't get homepage for %S package" package))))))
|
||||
61
lisp/lib/plist.el
Normal file
61
lisp/lib/plist.el
Normal file
|
|
@ -0,0 +1,61 @@
|
|||
;;; lisp/lib/plist.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;
|
||||
;;; Macros
|
||||
|
||||
;;; DEPRECATED In favor of `cl-callf'
|
||||
;;;###autoload
|
||||
(defmacro plist-put! (plist &rest rest)
|
||||
"Set each PROP VALUE pair in REST to PLIST in-place."
|
||||
`(cl-loop for (prop value)
|
||||
on (list ,@rest) by #'cddr
|
||||
do ,(if (symbolp plist)
|
||||
`(setq ,plist (plist-put ,plist prop value))
|
||||
`(plist-put ,plist prop value))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Library
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-plist-get (plist prop &optional nil-value)
|
||||
"Return PROP in PLIST, if it exists. Otherwise NIL-VALUE."
|
||||
(if-let (val (plist-member plist prop))
|
||||
(cadr val)
|
||||
nil-value))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-plist-merge (from-plist to-plist)
|
||||
"Non-destructively merge FROM-PLIST onto TO-PLIST"
|
||||
(let ((plist (copy-sequence from-plist)))
|
||||
(while plist
|
||||
(cl-callf plist-put to-plist (pop plist) (pop plist)))
|
||||
to-plist))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-plist-delete-nil (plist)
|
||||
"Delete `nil' properties from a copy of PLIST."
|
||||
(let (p)
|
||||
(while plist
|
||||
(if (car plist)
|
||||
(cl-callf plist-put p (car plist) (nth 1 plist)))
|
||||
(setq plist (cddr plist)))
|
||||
p))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-plist-keys (plist)
|
||||
"Return the keys in PLIST."
|
||||
(let (keys)
|
||||
(while plist
|
||||
(push (car plist) keys)
|
||||
(setq plist (cddr plist)))
|
||||
keys))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-plist-values (plist)
|
||||
"Return the values in PLIST."
|
||||
(let (keys)
|
||||
(while plist
|
||||
(push (cadr plist) keys)
|
||||
(setq plist (cddr plist)))
|
||||
keys))
|
||||
472
lisp/lib/print.el
Normal file
472
lisp/lib/print.el
Normal file
|
|
@ -0,0 +1,472 @@
|
|||
;;; lisp/lib/print.el -*- lexical-binding: t; -*-
|
||||
;;; Commentary
|
||||
;;;
|
||||
;;; This is Doom's output library, for controlling what does and doesn't get
|
||||
;;; logged, and provides a simple DSL for formatting output. It's mainly to
|
||||
;;; serve the noninteractive use-case, as `message' is more than good enough in
|
||||
;;; interactive sessions, but `print!' and `doom-log' are safe to use as a
|
||||
;;; drop-in replacement.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
(require 'ansi-color)
|
||||
|
||||
(defvar doom-print-ansi-alist
|
||||
'(;; fx
|
||||
(bold 1 :weight bold)
|
||||
(dark 2)
|
||||
(italic 3 :slant italic)
|
||||
(underscore 4 :underline t)
|
||||
(blink 5)
|
||||
(rapid 6)
|
||||
(contrary 7)
|
||||
(concealed 8)
|
||||
(strike 9 :strike-through t)
|
||||
;; fg
|
||||
(black 30 term-color-black)
|
||||
(red 31 term-color-red)
|
||||
(green 32 term-color-green)
|
||||
(yellow 33 term-color-yellow)
|
||||
(blue 34 term-color-blue)
|
||||
(magenta 35 term-color-magenta)
|
||||
(cyan 36 term-color-cyan)
|
||||
(white 37 term-color-white)
|
||||
;; bg
|
||||
(on-black 40 term-color-black)
|
||||
(on-red 41 term-color-red)
|
||||
(on-green 42 term-color-green)
|
||||
(on-yellow 43 term-color-yellow)
|
||||
(on-blue 44 term-color-blue)
|
||||
(on-magenta 45 term-color-magenta)
|
||||
(on-cyan 46 term-color-cyan)
|
||||
(on-white 47 term-color-white))
|
||||
"An alist of fg/bg/fx names mapped to ansi codes and term-color-* variables.
|
||||
|
||||
This serves as the cipher for converting (COLOR ...) function calls in `print!'
|
||||
and `format!' into colored output, where COLOR is any car of this list.")
|
||||
|
||||
(defvar doom-print-class-alist
|
||||
`((buffer . doom-print--buffer)
|
||||
(color . doom-print--style)
|
||||
(class . doom-print--class)
|
||||
(indent . doom-print--indent)
|
||||
(fill . doom-print--fill)
|
||||
(join . doom-print--join)
|
||||
(org . doom-print--org)
|
||||
(markup . doom-print--cli-markup)
|
||||
(trim . string-trim)
|
||||
(rtrim . string-trim-right)
|
||||
(ltrim . string-trim-left)
|
||||
(p . doom-print--paragraph)
|
||||
(buffer . (lambda (buffer)
|
||||
(with-current-buffer buffer
|
||||
(buffer-string))))
|
||||
(truncate . doom-print--truncate)
|
||||
(success . (lambda (str &rest args)
|
||||
(apply #'doom-print--style 'green
|
||||
(doom-print--indent str "✓ ")
|
||||
args)))
|
||||
(warn . (lambda (str &rest args)
|
||||
(apply #'doom-print--style 'yellow
|
||||
(doom-print--indent str "! ")
|
||||
args)))
|
||||
(error . (lambda (str &rest args)
|
||||
(apply #'doom-print--style 'red
|
||||
(doom-print--indent str "x ")
|
||||
args)))
|
||||
(item . (lambda (str &rest args)
|
||||
(doom-print--indent
|
||||
(if args (apply #'format str args) str)
|
||||
"- ")))
|
||||
(start . (lambda (str &rest args)
|
||||
(doom-print--indent
|
||||
(if args (apply #'format str args) str)
|
||||
"> ")))
|
||||
(path . abbreviate-file-name)
|
||||
(symbol . symbol-name)
|
||||
(relpath . (lambda (str &optional dir)
|
||||
(if (or (not str)
|
||||
(not (stringp str))
|
||||
(string-blank-p str))
|
||||
str
|
||||
(let ((dir (or dir (file-truename default-directory)))
|
||||
(str (file-truename str)))
|
||||
(if (file-in-directory-p str dir)
|
||||
(file-relative-name str dir)
|
||||
(abbreviate-file-name str))))))
|
||||
(filename . file-name-nondirectory)
|
||||
(dirname . (lambda (path)
|
||||
(unless (file-directory-p path)
|
||||
(setq path (file-name-directory path)))
|
||||
(directory-file-name path))))
|
||||
"An alist of text classes that map to transformation functions.
|
||||
|
||||
Any of these classes can be called like functions from within `format!' and
|
||||
`print!' calls, which will transform their input.")
|
||||
|
||||
(defvar doom-print-indent 0
|
||||
"Level to rigidly indent text returned by `format!' and `print!'.")
|
||||
|
||||
(defvar doom-print-indent-increment 2
|
||||
"Steps in which to increment `doom-print-indent' for consecutive levels.")
|
||||
|
||||
(defvar doom-print-backend (if noninteractive 'ansi 'text-properties)
|
||||
"Whether to print colors/styles with ANSI codes or with text properties.
|
||||
|
||||
Accepts `ansi' and `text-properties'. `nil' means don't render styles at all.")
|
||||
|
||||
(defvar doom-print-level (if init-file-debug 'debug 'info)
|
||||
"The default level of messages to print.")
|
||||
|
||||
(defvar doom-print-logging-level 'debug
|
||||
"The default logging level used by `doom-log'/`doom-print'.")
|
||||
|
||||
(defvar doom-print-message-level (if noninteractive 'debug 'info)
|
||||
"The default logging level used by `message'.")
|
||||
|
||||
(defvar doom-print--levels
|
||||
'(debug ; the system is thinking out loud
|
||||
info ; a FYI; to keep you posted
|
||||
warning ; a dismissable issue that may have reprecussions later
|
||||
error)) ; functionality has been disabled by misbehavior
|
||||
|
||||
(dotimes (i (length doom-print--levels))
|
||||
(put (nth i doom-print--levels) 'level i))
|
||||
|
||||
|
||||
;;
|
||||
;;; Library
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun doom-print
|
||||
(output &key
|
||||
(format t)
|
||||
(newline t)
|
||||
(stream standard-output)
|
||||
(level doom-print-level))
|
||||
"Print OUTPUT to stdout.
|
||||
|
||||
Unlike `message', this:
|
||||
- Respects `standard-output'.
|
||||
- Respects `doom-print-indent' (if FORMAT)
|
||||
- Prints to stdout instead of stderr in batch mode.
|
||||
- Respects more ANSI codes (only in batch mode).
|
||||
- No-ops if OUTPUT is nil or an empty/blank string.
|
||||
|
||||
Returns OUTPUT."
|
||||
(cl-check-type output (or null string))
|
||||
(when (and (stringp output)
|
||||
(not (string-blank-p output))
|
||||
(or (eq level t)
|
||||
(>= (get level 'level)
|
||||
(get doom-print-level 'level))))
|
||||
(let ((output (if format
|
||||
(doom-print--format "%s" output)
|
||||
output)))
|
||||
(princ output stream)
|
||||
(if newline (terpri stream))
|
||||
output)))
|
||||
|
||||
;;;###autoload
|
||||
(progn
|
||||
;; Autoload whole definition, so its buried uses don't pull in this whole file
|
||||
;; with them at expansion time.
|
||||
(defmacro doom-log (output &rest args)
|
||||
"Log a message in *Messages*.
|
||||
|
||||
Does not emit the message in the echo area. This is a macro instead of a
|
||||
function to prevent the potentially expensive execution of its arguments when
|
||||
debug mode is off."
|
||||
`(when (or init-file-debug noninteractive)
|
||||
(let ((inhibit-message t))
|
||||
(message
|
||||
"%s" (propertize
|
||||
(doom-print--format
|
||||
(format
|
||||
"* [%s] %s"
|
||||
,(let ((time `(format "%.06f" (float-time (time-subtract (current-time) before-init-time)))))
|
||||
(cond (noninteractive time)
|
||||
((bound-and-true-p doom--current-module)
|
||||
(format "[:%s %s] "
|
||||
(doom-keyword-name (car doom--current-module))
|
||||
(cdr doom--current-module)))
|
||||
((when-let (file (ignore-errors (file!)))
|
||||
(format "[%s] "
|
||||
(file-relative-name
|
||||
file (doom-path (file-name-directory file) "../")))))
|
||||
(time)))
|
||||
,output)
|
||||
,@args)
|
||||
'face 'font-lock-doc-face))))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro format! (message &rest args)
|
||||
"An alternative to `format' that understands (color ...) and converts them
|
||||
into faces or ANSI codes depending on the type of sesssion we're in."
|
||||
`(doom-print--format ,@(doom-print--apply `(,message ,@args))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro print-group! (&rest body)
|
||||
"Indents any `print!' or `format!' output within BODY."
|
||||
`(print-group-if! t ,@body))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro print-group-if! (condition &rest body)
|
||||
"Indents any `print!' or `format!' output within BODY."
|
||||
(declare (indent 1))
|
||||
`(let ((doom-print-indent
|
||||
(+ (if ,condition doom-print-indent-increment 0)
|
||||
doom-print-indent)))
|
||||
,@body))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro print! (message &rest args)
|
||||
"Prints MESSAGE, formatted with ARGS, to stdout.
|
||||
|
||||
Returns non-nil if the message is a non-empty string.
|
||||
|
||||
Can be colored using (color ...) blocks:
|
||||
|
||||
(print! \"Hello %s\" (bold (blue \"How are you?\")))
|
||||
(print! \"Hello %s\" (red \"World\"))
|
||||
(print! (green \"Great %s!\") \"success\")
|
||||
|
||||
Uses faces in interactive sessions and ANSI codes otherwise."
|
||||
`(doom-print (format! ,message ,@args) :format nil))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro insert! (&rest args)
|
||||
"Like `insert', but with the power of `format!'.
|
||||
|
||||
Each argument in ARGS can be a list, as if they were arguments to `format!':
|
||||
\(MESSAGE [ARGS...]).
|
||||
|
||||
\(fn &rest (MESSAGE . ARGS)...)"
|
||||
`(insert ,@(cl-loop for arg in args
|
||||
if (listp arg)
|
||||
collect `(format! ,@arg)
|
||||
else collect arg)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--format (message &rest args)
|
||||
(if (or (null message) (string-blank-p message))
|
||||
""
|
||||
(concat (make-string doom-print-indent 32)
|
||||
(replace-regexp-in-string
|
||||
"\n" (concat "\n" (make-string doom-print-indent 32))
|
||||
(if args (apply #'format message args) message)
|
||||
t t))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--indent (text &optional prefix)
|
||||
"Indent TEXT by WIDTH spaces. If ARGS, format TEXT with them."
|
||||
(with-temp-buffer
|
||||
(let ((width
|
||||
(cond ((null prefix)
|
||||
doom-print-indent-increment)
|
||||
((integerp prefix)
|
||||
prefix)
|
||||
((length (ansi-color-filter-apply (format "%s" prefix)))))))
|
||||
(insert (format "%s" (or text "")))
|
||||
(indent-rigidly (point-min) (point-max) width)
|
||||
(when (stringp prefix)
|
||||
(goto-char (point-min))
|
||||
(delete-char width)
|
||||
(insert prefix))
|
||||
(buffer-string))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--fill (message &optional column indent)
|
||||
"Ensure MSG is split into lines no longer than `fill-column'."
|
||||
(with-temp-buffer
|
||||
(let* ((fill-column (or column fill-column))
|
||||
(col 0)
|
||||
(indent (or indent 0))
|
||||
(fill-prefix (make-string indent ?\s)))
|
||||
(save-excursion
|
||||
(insert (format "%s" (or message ""))))
|
||||
;; HACK This monkey patches `fill-region' to not count ANSI codes as
|
||||
;; legitimate characters, when calculating per-line `fill-column'.
|
||||
(letf! (defun current-fill-column ()
|
||||
(let ((target (funcall current-fill-column)))
|
||||
(save-excursion
|
||||
(goto-char (line-beginning-position))
|
||||
(let ((n 0)
|
||||
(c 0))
|
||||
(while (and (not (eolp)) (<= n target))
|
||||
(save-match-data
|
||||
(if (looking-at ansi-color-control-seq-regexp)
|
||||
(let ((len (length (match-string 0))))
|
||||
(cl-incf c len)
|
||||
(forward-char len))
|
||||
(cl-incf n 1)
|
||||
(forward-char 1))))
|
||||
(+ target c (length fill-prefix))))))
|
||||
(fill-region (point-min) (point-max) nil t))
|
||||
(buffer-string))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--paragraph (&rest lines)
|
||||
"TODO"
|
||||
(doom-print--fill (apply #'concat lines)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--join (sequence &optional separator)
|
||||
"Ensure SEQUENCE is joined with SEPARATOR.
|
||||
|
||||
`nil' and empty strings in SEQUENCE are omitted."
|
||||
(mapconcat (doom-partial #'format "%s")
|
||||
(seq-remove (fn! (or (null %)
|
||||
(and (stringp %)
|
||||
(string-empty-p %))))
|
||||
sequence)
|
||||
(or separator " ")))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--truncate (text &optional col ellipsis)
|
||||
"Replaces basic org markup with ansi/text-properties."
|
||||
(truncate-string-to-width (or text "") (or col (- fill-column doom-print-indent))
|
||||
nil nil (or ellipsis "...")))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--buffer (buffer &optional beg end)
|
||||
"Replaces basic org markup with ansi/text-properties."
|
||||
(if (and (bufferp buffer) (buffer-live-p buffer))
|
||||
(with-current-buffer buffer
|
||||
(if (or beg end)
|
||||
(buffer-substring (or beg (point-min))
|
||||
(or end (point-max)))
|
||||
(buffer-string)))
|
||||
""))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--cli-markup (text)
|
||||
"Replace `...', `...`, and ```...``` quotes in TEXT with CLI formatting.
|
||||
|
||||
- `$ENVVAR' = bolded
|
||||
- `--switch' = bolded
|
||||
- `ARG' = underlined
|
||||
- `symbol' = highlighted in blue
|
||||
- `arbitrary code` = highlighted in blue
|
||||
- ```
|
||||
Arbitrary multiline code gets highlighted in blue too.
|
||||
```"
|
||||
(if (not text) ""
|
||||
(let ((case-fold-search nil))
|
||||
;; TODO Syntax highlighting?
|
||||
(replace-regexp-in-string
|
||||
" *```\n\\(.+?\\)\n *```" (doom-print--style 'blue "%s" "\\1")
|
||||
(replace-regexp-in-string
|
||||
"`\\$ \\([^`\n]+?\\)`" (format "`%s`" (doom-print--style 'blue "%s" "\\1"))
|
||||
(replace-regexp-in-string
|
||||
"`\\([^ \n]+?\\)'"
|
||||
(let ((styles '(("^\\$" . envvar)
|
||||
("^--?" . option)
|
||||
("^[A-Z][A-Z0-9-_]*$" . arg)
|
||||
("." . symbol))))
|
||||
(lambda (match)
|
||||
(let ((text (match-string 1 match)))
|
||||
(pcase (assoc-default text styles #'string-match-p)
|
||||
(`arg (doom-print--style 'underscore "%s" text))
|
||||
(`envvar (doom-print--style 'bold "%s" text))
|
||||
(`option (doom-print--style 'bold "%s" text))
|
||||
(_ (format "`%s'" (doom-print--style 'blue "%s" text)))))))
|
||||
text t)
|
||||
t)
|
||||
t))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--org (text)
|
||||
"Replaces basic Org markup with ansi/text-properties.
|
||||
|
||||
All emphasis markers need to be preceded by a backslash."
|
||||
(let* ((inhibit-modification-hooks t)
|
||||
(styles '((?* . bold)
|
||||
(?_ . underscore)
|
||||
(?/ . italic)
|
||||
(?= . magenta)
|
||||
(?+ . strike)
|
||||
(?~ . blue)))
|
||||
(fences (regexp-quote (mapconcat #'char-to-string (mapcar #'car styles) ""))))
|
||||
(with-temp-buffer
|
||||
(save-excursion (insert text))
|
||||
(while (re-search-forward (format "\\([%s]\\)" fences) nil t)
|
||||
(unless (= (char-before (match-beginning 0)) ?\\)
|
||||
(let* ((beg (match-beginning 0))
|
||||
(ibeg (point))
|
||||
(fence (match-string 1))
|
||||
(fence-re (regexp-quote fence)))
|
||||
(when (re-search-forward (format "[^\\]%s" fence-re) (line-end-position 2) t)
|
||||
(let ((end (point))
|
||||
(iend (1- (point))))
|
||||
(let ((text (buffer-substring ibeg iend)))
|
||||
(when-let (style (cdr (assq (string-to-char fence) styles)))
|
||||
(goto-char beg)
|
||||
(delete-region beg end)
|
||||
(insert (doom-print--style style "%s" text)))))
|
||||
(goto-char beg)))))
|
||||
(buffer-string))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--style (style format &rest args)
|
||||
"Apply STYLE to formatted MESSAGE with ARGS.
|
||||
|
||||
STYLE is a symbol that correlates to `doom-print-ansi-alist'.
|
||||
|
||||
In a noninteractive session, this wraps the result in ansi color codes.
|
||||
Otherwise, it maps colors to a term-color-* face."
|
||||
(let* ((code (cadr (assq style doom-print-ansi-alist)))
|
||||
(format (format "%s" (or format "")))
|
||||
(message (if args (apply #'format format args) format)))
|
||||
(unless code
|
||||
(error "Invalid print style: %s" style))
|
||||
(pcase doom-print-backend
|
||||
(`ansi
|
||||
(format "\e[0%dm%s\e[%dm" code message 0))
|
||||
(`text-properties
|
||||
(require 'term) ; piggyback on term's color faces
|
||||
(propertize
|
||||
message
|
||||
'face
|
||||
(append (get-text-property 0 'face format)
|
||||
(cond ((>= code 40)
|
||||
`(:background ,(caddr (assq style doom-print-ansi-alist))))
|
||||
((>= code 30)
|
||||
`(:foreground ,(face-foreground (caddr (assq style doom-print-ansi-alist)))))
|
||||
((cddr (assq style doom-print-ansi-alist)))))))
|
||||
(_ message))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--class (class format &rest args)
|
||||
"Apply CLASS to formatted format with ARGS.
|
||||
|
||||
CLASS is derived from `doom-print-class-alist', and can contain any arbitrary,
|
||||
transformative logic."
|
||||
(let (fn)
|
||||
(cond ((setq fn (cdr (assq class doom-print-class-alist)))
|
||||
(if (functionp fn)
|
||||
(apply fn format args)
|
||||
(error "%s does not have a function" class)))
|
||||
(args (apply #'format format args))
|
||||
(format))))
|
||||
|
||||
(defun doom-print--apply (forms &optional sub)
|
||||
"Replace color-name functions with calls to `doom-print--style'."
|
||||
(cond ((null forms) nil)
|
||||
((listp forms)
|
||||
(append (cond ((not (symbolp (car forms)))
|
||||
(list (doom-print--apply (car forms))))
|
||||
(sub
|
||||
(list (car forms)))
|
||||
((assq (car forms) doom-print-ansi-alist)
|
||||
`(doom-print--style ',(car forms)))
|
||||
((assq (car forms) doom-print-class-alist)
|
||||
`(doom-print--class ',(car forms)))
|
||||
((list (car forms))))
|
||||
(doom-print--apply (cdr forms) t)
|
||||
nil))
|
||||
(forms)))
|
||||
42
lisp/lib/process.el
Normal file
42
lisp/lib/process.el
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
;;; lisp/lib/process.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-call-process (command &rest args)
|
||||
"Execute COMMAND with ARGS synchronously.
|
||||
|
||||
Returns (STATUS . OUTPUT) when it is done, where STATUS is the returned error
|
||||
code of the process and OUTPUT is its stdout output."
|
||||
(with-temp-buffer
|
||||
(cons (or (apply #'call-process command nil t nil (remq nil args))
|
||||
-1)
|
||||
(string-trim (buffer-string)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-exec-process (command &rest args)
|
||||
"Execute COMMAND with ARGS synchronously.
|
||||
|
||||
Unlike `doom-call-process', this pipes output to `standard-output' on the fly to
|
||||
simulate 'exec' in the shell, so batch scripts could run external programs
|
||||
synchronously without sacrificing their output.
|
||||
|
||||
Warning: freezes indefinitely on any stdin prompt."
|
||||
;; FIXME Is there any way to handle prompts?
|
||||
(with-temp-buffer
|
||||
(cons (let ((process
|
||||
(make-process :name "doom-sh"
|
||||
:buffer (current-buffer)
|
||||
:command (cons command (remq nil args))
|
||||
:connection-type 'pipe))
|
||||
done-p)
|
||||
(set-process-filter
|
||||
process (lambda (_process output)
|
||||
(princ output (current-buffer))
|
||||
(princ (doom--format output))))
|
||||
(set-process-sentinel
|
||||
process (lambda (process _event)
|
||||
(when (memq (process-status process) '(exit stop))
|
||||
(setq done-p t))))
|
||||
(while (not done-p)
|
||||
(sit-for 0.1))
|
||||
(process-exit-status process))
|
||||
(string-trim (buffer-string)))))
|
||||
180
lisp/lib/projects.el
Normal file
180
lisp/lib/projects.el
Normal file
|
|
@ -0,0 +1,180 @@
|
|||
;;; lisp/lib/projects.el -*- lexical-binding: t; -*-
|
||||
|
||||
;; HACK We forward declare these variables because they are let-bound in a
|
||||
;; number of places with no guarantee that they've been defined yet (i.e.
|
||||
;; that `projectile' is loaded). If a variable is defined with `defvar'
|
||||
;; while it is lexically bound, you get "Defining as dynamic an already
|
||||
;; lexical var" errors in Emacs 28+).
|
||||
;;;###autoload (defvar projectile-project-root nil)
|
||||
;;;###autoload (defvar projectile-enable-caching (not noninteractive))
|
||||
;;;###autoload (defvar projectile-require-project-root 'prompt)
|
||||
|
||||
;;;###autodef
|
||||
(cl-defun set-project-type! (name &key predicate compile run test configure dir)
|
||||
"Add a project type to `projectile-project-type'."
|
||||
(declare (indent 1))
|
||||
(after! projectile
|
||||
(add-to-list 'projectile-project-types
|
||||
(list name
|
||||
'marker-files predicate
|
||||
'compilation-dir dir
|
||||
'configure-command configure
|
||||
'compile-command compile
|
||||
'test-command test
|
||||
'run-command run))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Macros
|
||||
|
||||
;;;###autoload
|
||||
(defmacro project-file-exists-p! (files)
|
||||
"Checks if the project has the specified FILES.
|
||||
Paths are relative to the project root, unless they start with ./ or ../ (in
|
||||
which case they're relative to `default-directory'). If they start with a slash,
|
||||
they are absolute."
|
||||
`(file-exists-p! ,files (doom-project-root)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/find-file-in-other-project (project-root)
|
||||
"Performs `projectile-find-file' in a known project of your choosing."
|
||||
(interactive
|
||||
(list
|
||||
(completing-read "Find file in project: " (projectile-relevant-known-projects))))
|
||||
(unless (file-directory-p project-root)
|
||||
(error "Project directory '%s' doesn't exist" project-root))
|
||||
(doom-project-find-file project-root))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/browse-in-other-project (project-root)
|
||||
"Performs `find-file' in a known project of your choosing."
|
||||
(interactive
|
||||
(list
|
||||
(completing-read "Browse in project: " (projectile-relevant-known-projects))))
|
||||
(unless (file-directory-p project-root)
|
||||
(error "Project directory '%s' doesn't exist" project-root))
|
||||
(doom-project-browse project-root))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/browse-in-emacsd ()
|
||||
"Browse files from `doom-emacs-dir'."
|
||||
(interactive) (doom-project-browse doom-emacs-dir))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/find-file-in-emacsd ()
|
||||
"Find a file under `doom-emacs-dir', recursively."
|
||||
(interactive) (doom-project-find-file doom-emacs-dir))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/add-directory-as-project (dir)
|
||||
"Register an arbitrary directory as a project.
|
||||
|
||||
Unlike `projectile-add-known-project', if DIR isn't a valid project, a .project
|
||||
file will be created within it so that it will always be treated as one. This
|
||||
command will throw an error if a parent of DIR is a valid project (which would
|
||||
mask DIR)."
|
||||
(interactive "D")
|
||||
(let ((short-dir (abbreviate-file-name dir)))
|
||||
(unless (file-equal-p (doom-project-root dir) dir)
|
||||
(with-temp-file (doom-path dir ".project")))
|
||||
(let ((proj-dir (doom-project-root dir)))
|
||||
(unless (file-equal-p proj-dir dir)
|
||||
(user-error "Can't add %S as a project, because %S is already a project"
|
||||
short-dir (abbreviate-file-name proj-dir)))
|
||||
(message "%S was not a project; adding .project file to it"
|
||||
short-dir (abbreviate-file-name proj-dir))
|
||||
(projectile-add-known-project dir))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Library
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-project-p (&optional dir)
|
||||
"Return t if DIR (defaults to `default-directory') is a valid project."
|
||||
(and (doom-project-root dir)
|
||||
t))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-project-root (&optional dir)
|
||||
"Return the project root of DIR (defaults to `default-directory').
|
||||
Returns nil if not in a project."
|
||||
(let ((projectile-project-root
|
||||
(unless dir (bound-and-true-p projectile-project-root)))
|
||||
projectile-require-project-root)
|
||||
(projectile-project-root dir)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-project-name (&optional dir)
|
||||
"Return the name of the current project.
|
||||
|
||||
Returns '-' if not in a valid project."
|
||||
(if-let (project-root (or (doom-project-root dir)
|
||||
(if dir (expand-file-name dir))))
|
||||
(funcall projectile-project-name-function project-root)
|
||||
"-"))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-project-expand (name &optional dir)
|
||||
"Expand NAME to project root."
|
||||
(expand-file-name name (doom-project-root dir)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-project-find-file (dir)
|
||||
"Jump to a file in DIR (searched recursively).
|
||||
|
||||
If DIR is not a project, it will be indexed (but not cached)."
|
||||
(unless (file-directory-p dir)
|
||||
(error "Directory %S does not exist" dir))
|
||||
(unless (file-readable-p dir)
|
||||
(error "Directory %S isn't readable" dir))
|
||||
(let* ((default-directory (file-truename dir))
|
||||
(projectile-project-root (doom-project-root dir))
|
||||
(projectile-enable-caching projectile-enable-caching))
|
||||
(cond ((and projectile-project-root (file-equal-p projectile-project-root default-directory))
|
||||
(unless (doom-project-p default-directory)
|
||||
;; Disable caching if this is not a real project; caching
|
||||
;; non-projects easily has the potential to inflate the projectile
|
||||
;; cache beyond reason.
|
||||
(setq projectile-enable-caching nil))
|
||||
(call-interactively
|
||||
;; Intentionally avoid `helm-projectile-find-file', because it runs
|
||||
;; asynchronously, and thus doesn't see the lexical
|
||||
;; `default-directory'
|
||||
(if (doom-module-p :completion 'ivy)
|
||||
#'counsel-projectile-find-file
|
||||
#'projectile-find-file)))
|
||||
((and (bound-and-true-p vertico-mode)
|
||||
(fboundp '+vertico/find-file-in))
|
||||
(+vertico/find-file-in default-directory))
|
||||
((and (bound-and-true-p ivy-mode)
|
||||
(fboundp 'counsel-file-jump))
|
||||
(call-interactively #'counsel-file-jump))
|
||||
((project-current nil dir)
|
||||
(project-find-file-in nil nil dir))
|
||||
((and (bound-and-true-p helm-mode)
|
||||
(fboundp 'helm-find-files))
|
||||
(call-interactively #'helm-find-files))
|
||||
((call-interactively #'find-file)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-project-browse (dir)
|
||||
"Traverse a file structure starting linearly from DIR."
|
||||
(let ((default-directory (file-truename (expand-file-name dir))))
|
||||
(call-interactively
|
||||
(cond ((doom-module-p :completion 'ivy)
|
||||
#'counsel-find-file)
|
||||
((doom-module-p :completion 'helm)
|
||||
#'helm-find-files)
|
||||
(#'find-file)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-project-ignored-p (project-root)
|
||||
"Return non-nil if temporary file or a straight package."
|
||||
(unless (file-remote-p project-root)
|
||||
(or (file-in-directory-p project-root temporary-file-directory)
|
||||
(file-in-directory-p project-root doom-local-dir))))
|
||||
183
lisp/lib/sandbox.el
Normal file
183
lisp/lib/sandbox.el
Normal file
|
|
@ -0,0 +1,183 @@
|
|||
;;; lisp/lib/sandbox.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defvar doom-sandbox-buffer-name "*doom:sandbox*"
|
||||
"Name of the Doom sandbox buffer.")
|
||||
|
||||
(defvar doom-sandbox-dir
|
||||
(expand-file-name "doom-sandbox" (temporary-file-directory))
|
||||
"TODO")
|
||||
|
||||
(defvar doom-sandbox-preamble
|
||||
";; Welcome to the sandbox!
|
||||
;;
|
||||
;; This is a test bed for running Emacs Lisp in another instance of Emacs that
|
||||
;; has varying amounts of Doom loaded:
|
||||
;;
|
||||
;; - vanilla Emacs (nothing loaded) \\[doom--run-vanilla-emacs]
|
||||
;; - vanilla Doom (only Doom core) \\[doom--run-vanilla-doom]
|
||||
;; - Doom + modules - your private config \\[doom--run-vanilla-doom+]
|
||||
;; - Doom + modules + your private config \\[doom--run-full-doom]
|
||||
;;
|
||||
;; This is done without sacrificing access to installed packages. Use the sandbox
|
||||
;; to reproduce bugs and determine if Doom is to blame.\n\n"
|
||||
"TODO")
|
||||
|
||||
(defun doom--sandbox-launch (args forms)
|
||||
(require 'package)
|
||||
(require 'restart-emacs)
|
||||
(let* ((sandbox-file (expand-file-name "init.el" doom-sandbox-dir))
|
||||
(args (append args (list "-l" sandbox-file))))
|
||||
(delete-directory doom-sandbox-dir 'recursive)
|
||||
(make-directory doom-sandbox-dir 'parents)
|
||||
(with-temp-file sandbox-file
|
||||
(prin1 forms (current-buffer)))
|
||||
(condition-case-unless-debug e
|
||||
(cond ((display-graphic-p)
|
||||
(if (memq system-type '(windows-nt ms-dos))
|
||||
(restart-emacs--start-gui-on-windows args)
|
||||
(restart-emacs--start-gui-using-sh args)))
|
||||
((memq system-type '(windows-nt ms-dos))
|
||||
(user-error "Cannot start another Emacs from Windows shell."))
|
||||
((suspend-emacs
|
||||
(format "%s %s -nw; fg"
|
||||
(shell-quote-argument (restart-emacs--get-emacs-binary))
|
||||
(mapconcat #'shell-quote-argument args " ")))))
|
||||
(error
|
||||
(delete-directory doom-sandbox-dir 'recursive)
|
||||
(signal (car e) (cdr e))))))
|
||||
|
||||
|
||||
(defun doom--sandbox-run (&optional mode)
|
||||
"TODO"
|
||||
(doom--sandbox-launch
|
||||
(unless (eq mode 'doom) '("-Q"))
|
||||
(let ((forms
|
||||
(read (format "(progn\n%s\n)"
|
||||
(buffer-substring-no-properties
|
||||
(point-min)
|
||||
(point-max))))))
|
||||
(if (eq mode 'doom)
|
||||
forms
|
||||
`(progn
|
||||
;; doom variables
|
||||
(setq init-file-debug t
|
||||
doom-emacs-dir ,doom-emacs-dir
|
||||
doom-cache-dir ,(expand-file-name "cache/" doom-sandbox-dir)
|
||||
doom-etc-dir ,(expand-file-name "etc/" doom-sandbox-dir))
|
||||
(defun doom--write-to-etc-dir-a (fn &rest args)
|
||||
(let ((user-emacs-directory doom-etc-dir))
|
||||
(apply fn args)))
|
||||
(advice-add #'locate-user-emacs-file :around #'doom--write-to-etc-dir-a)
|
||||
;; emacs essential variables
|
||||
(setq before-init-time (current-time)
|
||||
after-init-time nil
|
||||
init-file-debug init-file-debug
|
||||
noninteractive nil
|
||||
process-environment (get 'process-environment 'initial-value)
|
||||
exec-path (get 'exec-path 'initial-value)
|
||||
load-path ',load-path
|
||||
user-init-file load-file-name)
|
||||
;; package.el
|
||||
(setq package--init-file-ensured t
|
||||
package-user-dir ,package-user-dir
|
||||
package-archives ',package-archives)
|
||||
;; (add-hook 'kill-emacs-hook
|
||||
;; (lambda ()
|
||||
;; (delete-file user-init-file)
|
||||
;; (when (file-equal-p user-emacs-directory ,doom-sandbox-dir)
|
||||
;; (delete-directory user-emacs-directory 'recursive))))
|
||||
(with-eval-after-load 'undo-tree
|
||||
;; HACK `undo-tree' sometimes throws errors because
|
||||
;; `buffer-undo-tree' isn't correctly initialized.
|
||||
(setq-default buffer-undo-tree (make-undo-tree)))
|
||||
;; Then launch as much about Emacs as we can
|
||||
(defun --run-- () ,forms)
|
||||
,(pcase mode
|
||||
(`doom
|
||||
'(--run--))
|
||||
(`vanilla-doom+ ; Doom core + modules - private config
|
||||
`(progn
|
||||
(load-file ,(expand-file-name "doom.el" doom-core-dir))
|
||||
(setq doom-modules-dirs (list doom-modules-dir))
|
||||
(let ((doom-init-modules-p t))
|
||||
(doom-initialize)
|
||||
(doom-initialize-core-modules))
|
||||
(setq doom-modules ',doom-modules)
|
||||
(maphash (lambda (key plist)
|
||||
(doom-module-put
|
||||
(car key) (cdr key)
|
||||
:path (doom-module-locate-path (car key) (cdr key))))
|
||||
doom-modules)
|
||||
(--run--)
|
||||
(maphash (doom-module-loader doom-module-init-file) doom-modules)
|
||||
(maphash (doom-module-loader doom-module-config-file) doom-modules)
|
||||
(doom-run-hooks 'doom-init-modules-hook)))
|
||||
(`vanilla-doom ; only Doom core
|
||||
`(progn
|
||||
(load-file ,(expand-file-name "doom.el" doom-core-dir))
|
||||
(let ((doom-init-modules-p t))
|
||||
(doom-initialize)
|
||||
(doom-initialize-core-modules))
|
||||
(--run--)))
|
||||
(`vanilla ; nothing loaded
|
||||
`(progn
|
||||
(if (boundp 'comp-deferred-compilation)
|
||||
;; REVIEW Remove me after a month
|
||||
(setq comp-deferred-compilation nil
|
||||
comp-deferred-compilation-deny-list ',(bound-and-true-p native-comp-async-env-modifier-form)
|
||||
comp-async-env-modifier-form ',(bound-and-true-p native-comp-async-env-modifier-form)
|
||||
comp-eln-load-path ',(bound-and-true-p native-comp-eln-load-path))
|
||||
(setq native-comp-deferred-compilation nil
|
||||
native-comp-deferred-compilation-deny-list ',(bound-and-true-p native-comp-async-env-modifier-form)
|
||||
native-comp-async-env-modifier-form ',(bound-and-true-p native-comp-async-env-modifier-form)
|
||||
native-comp-eln-load-path ',(bound-and-true-p native-comp-eln-load-path)))
|
||||
(package-initialize t)
|
||||
(--run--))))
|
||||
;; Then rerun Emacs' startup hooks to simulate a fresh Emacs session,
|
||||
;; because they've already fired.
|
||||
(fset 'doom-run-hook #',(symbol-function #'doom-run-hook))
|
||||
(fset 'doom-run-hooks #',(symbol-function #'doom-run-hooks))
|
||||
(fset 'doom-run-all-startup-hooks-h #',(symbol-function #'doom-run-all-startup-hooks-h))
|
||||
(doom-run-all-startup-hooks-h))))))
|
||||
|
||||
(fset 'doom--run-vanilla-emacs (cmd! (doom--sandbox-run 'vanilla)))
|
||||
(fset 'doom--run-vanilla-doom (cmd! (doom--sandbox-run 'vanilla-doom)))
|
||||
(fset 'doom--run-vanilla-doom+ (cmd! (doom--sandbox-run 'vanilla-doom+)))
|
||||
(fset 'doom--run-full-doom (cmd! (doom--sandbox-run 'doom)))
|
||||
|
||||
(defvar doom-sandbox-emacs-lisp-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map (kbd "C-c C-c") #'doom--run-vanilla-emacs)
|
||||
(define-key map (kbd "C-c C-d") #'doom--run-vanilla-doom)
|
||||
(define-key map (kbd "C-c C-p") #'doom--run-vanilla-doom+)
|
||||
(define-key map (kbd "C-c C-f") #'doom--run-full-doom)
|
||||
(define-key map (kbd "C-c C-k") #'kill-current-buffer)
|
||||
map))
|
||||
|
||||
(define-derived-mode doom-sandbox-emacs-lisp-mode emacs-lisp-mode "Sandbox Elisp"
|
||||
"TODO")
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/sandbox ()
|
||||
"Open the Emacs Lisp sandbox.
|
||||
|
||||
This is a test bed for running Emacs Lisp in another instance of Emacs with
|
||||
varying amounts of Doom loaded, including:
|
||||
|
||||
a) vanilla Emacs (nothing loaded),
|
||||
b) vanilla Doom (only Doom core),
|
||||
c) Doom + modules - your private config or
|
||||
c) Doom + modules + your private config (a complete Doom session)
|
||||
|
||||
This is done without sacrificing access to installed packages. Use the sandbox
|
||||
to reproduce bugs and determine if Doom is to blame."
|
||||
(interactive)
|
||||
(pop-to-buffer
|
||||
(with-current-buffer (get-buffer-create doom-sandbox-buffer-name)
|
||||
(doom-sandbox-emacs-lisp-mode)
|
||||
(setq-local default-directory doom-emacs-dir)
|
||||
(and (buffer-live-p (get-buffer doom-sandbox-buffer-name))
|
||||
(= (buffer-size) 0)
|
||||
(insert (substitute-command-keys doom-sandbox-preamble)))
|
||||
(goto-char (point-max))
|
||||
(current-buffer))))
|
||||
199
lisp/lib/scratch.el
Normal file
199
lisp/lib/scratch.el
Normal file
|
|
@ -0,0 +1,199 @@
|
|||
;;; lisp/lib/scratch.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defvar doom-scratch-default-file "__default"
|
||||
"The default file name for a project-less scratch buffer.
|
||||
|
||||
Will be saved in `doom-scratch-dir'.")
|
||||
|
||||
(defvar doom-scratch-dir (concat doom-etc-dir "scratch")
|
||||
"Where to save persistent scratch buffers.")
|
||||
|
||||
(defvar doom-scratch-initial-major-mode nil
|
||||
"What major mode to start fresh scratch buffers in.
|
||||
|
||||
Scratch buffers preserve their last major mode, however, so this only affects
|
||||
the first, fresh scratch buffer you create. This accepts:
|
||||
|
||||
t Inherits the major mode of the last buffer you had selected.
|
||||
nil Uses `fundamental-mode'
|
||||
MAJOR-MODE Any major mode symbol")
|
||||
|
||||
(defvar doom-scratch-buffers nil
|
||||
"A list of active scratch buffers.")
|
||||
|
||||
(defvar doom-scratch-current-project nil
|
||||
"The name of the project associated with the current scratch buffer.")
|
||||
(put 'doom-scratch-current-project 'permanent-local t)
|
||||
|
||||
(defvar doom-scratch-buffer-hook ()
|
||||
"The hooks to run after a scratch buffer is created.")
|
||||
|
||||
|
||||
(defun doom--load-persistent-scratch-buffer (project-name)
|
||||
(setq-local doom-scratch-current-project
|
||||
(or project-name
|
||||
doom-scratch-default-file))
|
||||
(let ((smart-scratch-file
|
||||
(expand-file-name (concat doom-scratch-current-project ".el")
|
||||
doom-scratch-dir)))
|
||||
(make-directory doom-scratch-dir t)
|
||||
(when (file-readable-p smart-scratch-file)
|
||||
(message "Reading %s" smart-scratch-file)
|
||||
(cl-destructuring-bind (content point mode)
|
||||
(with-temp-buffer
|
||||
(save-excursion (insert-file-contents smart-scratch-file))
|
||||
(read (current-buffer)))
|
||||
(erase-buffer)
|
||||
(funcall mode)
|
||||
(insert content)
|
||||
(goto-char point)
|
||||
t))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-scratch-buffer (&optional dont-restore-p mode directory project-name)
|
||||
"Return a scratchpad buffer in major MODE."
|
||||
(let* ((buffer-name (if project-name
|
||||
(format "*doom:scratch (%s)*" project-name)
|
||||
"*doom:scratch*"))
|
||||
(buffer (get-buffer buffer-name)))
|
||||
(with-current-buffer
|
||||
(or buffer (get-buffer-create buffer-name))
|
||||
(setq default-directory directory)
|
||||
(setq-local so-long--inhibited t)
|
||||
(if dont-restore-p
|
||||
(erase-buffer)
|
||||
(unless buffer
|
||||
(doom--load-persistent-scratch-buffer project-name)
|
||||
(when (and (eq major-mode 'fundamental-mode)
|
||||
(functionp mode))
|
||||
(funcall mode))))
|
||||
(cl-pushnew (current-buffer) doom-scratch-buffers)
|
||||
(add-transient-hook! 'doom-switch-buffer-hook (doom-persist-scratch-buffers-h))
|
||||
(add-transient-hook! 'doom-switch-window-hook (doom-persist-scratch-buffers-h))
|
||||
(add-hook 'kill-buffer-hook #'doom-persist-scratch-buffer-h nil 'local)
|
||||
(run-hooks 'doom-scratch-buffer-created-hook)
|
||||
(current-buffer))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Persistent scratch buffer
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-persist-scratch-buffer-h ()
|
||||
"Save the current buffer to `doom-scratch-dir'."
|
||||
(let ((content (buffer-substring-no-properties (point-min) (point-max)))
|
||||
(point (point))
|
||||
(mode major-mode))
|
||||
(with-temp-file
|
||||
(expand-file-name (concat (or doom-scratch-current-project
|
||||
doom-scratch-default-file)
|
||||
".el")
|
||||
doom-scratch-dir)
|
||||
(prin1 (list content
|
||||
point
|
||||
mode)
|
||||
(current-buffer)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-persist-scratch-buffers-h ()
|
||||
"Save all scratch buffers to `doom-scratch-dir'."
|
||||
(setq doom-scratch-buffers
|
||||
(cl-delete-if-not #'buffer-live-p doom-scratch-buffers))
|
||||
(dolist (buffer doom-scratch-buffers)
|
||||
(with-current-buffer buffer
|
||||
(doom-persist-scratch-buffer-h))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-persist-scratch-buffers-after-switch-h ()
|
||||
"Kill scratch buffers when they are no longer visible, saving them to disk."
|
||||
(unless (cl-some #'get-buffer-window doom-scratch-buffers)
|
||||
(mapc #'kill-buffer doom-scratch-buffers)
|
||||
(remove-hook 'doom-switch-buffer-hook #'doom-persist-scratch-buffers-after-switch-h)))
|
||||
|
||||
;;;###autoload
|
||||
(unless noninteractive
|
||||
(add-hook 'kill-emacs-hook #'doom-persist-scratch-buffers-h))
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defvar projectile-enable-caching)
|
||||
;;;###autoload
|
||||
(defun doom/open-scratch-buffer (&optional arg project-p same-window-p)
|
||||
"Pop up a persistent scratch buffer.
|
||||
|
||||
If passed the prefix ARG, do not restore the last scratch buffer.
|
||||
If PROJECT-P is non-nil, open a persistent scratch buffer associated with the
|
||||
current project."
|
||||
(interactive "P")
|
||||
(let (projectile-enable-caching)
|
||||
(funcall
|
||||
(if same-window-p
|
||||
#'switch-to-buffer
|
||||
#'pop-to-buffer)
|
||||
(doom-scratch-buffer
|
||||
arg
|
||||
(cond ((eq doom-scratch-initial-major-mode t)
|
||||
(unless (or buffer-read-only
|
||||
(derived-mode-p 'special-mode)
|
||||
(string-match-p "^ ?\\*" (buffer-name)))
|
||||
major-mode))
|
||||
((null doom-scratch-initial-major-mode)
|
||||
nil)
|
||||
((symbolp doom-scratch-initial-major-mode)
|
||||
doom-scratch-initial-major-mode))
|
||||
default-directory
|
||||
(when project-p
|
||||
(doom-project-name))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/switch-to-scratch-buffer (&optional arg project-p)
|
||||
"Like `doom/open-scratch-buffer', but switches to it in the current window.
|
||||
|
||||
If passed the prefix ARG, do not restore the last scratch buffer."
|
||||
(interactive "P")
|
||||
(doom/open-scratch-buffer arg project-p 'same-window))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/open-project-scratch-buffer (&optional arg same-window-p)
|
||||
"Opens the (persistent) project scratch buffer in a popup.
|
||||
|
||||
If passed the prefix ARG, do not restore the last scratch buffer."
|
||||
(interactive "P")
|
||||
(doom/open-scratch-buffer arg 'project same-window-p))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/switch-to-project-scratch-buffer (&optional arg)
|
||||
"Like `doom/open-project-scratch-buffer', but switches to it in the current
|
||||
window.
|
||||
|
||||
If passed the prefix ARG, do not restore the last scratch buffer."
|
||||
(interactive "P")
|
||||
(doom/open-project-scratch-buffer arg 'same-window))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/revert-scratch-buffer ()
|
||||
"Revert scratch buffer to last persistent state."
|
||||
(interactive)
|
||||
(unless (string-match-p "^\\*doom:scratch" (buffer-name))
|
||||
(user-error "Not in a scratch buffer"))
|
||||
(when (doom--load-persistent-scratch-buffer doom-scratch-current-project)
|
||||
(message "Reloaded scratch buffer")))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/delete-persistent-scratch-file (&optional arg)
|
||||
"Deletes a scratch buffer file in `doom-scratch-dir'.
|
||||
|
||||
If prefix ARG, delete all persistent scratches."
|
||||
(interactive)
|
||||
(if arg
|
||||
(progn
|
||||
(delete-directory doom-scratch-dir t)
|
||||
(message "Cleared %S" (abbreviate-file-name doom-scratch-dir)))
|
||||
(make-directory doom-scratch-dir t)
|
||||
(let ((file (read-file-name "Delete scratch file > " doom-scratch-dir "scratch")))
|
||||
(if (not (file-exists-p file))
|
||||
(message "%S does not exist" (abbreviate-file-name file))
|
||||
(delete-file file)
|
||||
(message "Successfully deleted %S" (abbreviate-file-name file))))))
|
||||
152
lisp/lib/sessions.el
Normal file
152
lisp/lib/sessions.el
Normal file
|
|
@ -0,0 +1,152 @@
|
|||
;;; lisp/lib/sessions.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defvar desktop-base-file-name)
|
||||
(defvar desktop-dirname)
|
||||
(defvar desktop-restore-eager)
|
||||
(defvar desktop-file-modtime)
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-session-file (&optional name)
|
||||
"TODO"
|
||||
(cond ((require 'persp-mode nil t)
|
||||
(expand-file-name (or name persp-auto-save-fname) persp-save-dir))
|
||||
((require 'desktop nil t)
|
||||
(if name
|
||||
(expand-file-name name (file-name-directory (desktop-full-file-name)))
|
||||
(desktop-full-file-name)))
|
||||
((error "No session backend available"))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-save-session (&optional file)
|
||||
"TODO"
|
||||
(setq file (expand-file-name (or file (doom-session-file))))
|
||||
(cond ((require 'persp-mode nil t)
|
||||
(unless persp-mode (persp-mode +1))
|
||||
(setq persp-auto-save-opt 0)
|
||||
(persp-save-state-to-file file))
|
||||
((and (require 'frameset nil t)
|
||||
(require 'restart-emacs nil t))
|
||||
(let ((frameset-filter-alist (append '((client . restart-emacs--record-tty-file))
|
||||
frameset-filter-alist))
|
||||
(desktop-base-file-name (file-name-nondirectory file))
|
||||
(desktop-dirname (file-name-directory file))
|
||||
(desktop-restore-eager t)
|
||||
desktop-file-modtime)
|
||||
(make-directory desktop-dirname t)
|
||||
;; Prevents confirmation prompts
|
||||
(let ((desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name)))))
|
||||
(desktop-save desktop-dirname t))))
|
||||
((error "No session backend to save session with"))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-load-session (&optional file)
|
||||
"TODO"
|
||||
(setq file (expand-file-name (or file (doom-session-file))))
|
||||
(message "Attempting to load %s" file)
|
||||
(cond ((not (file-readable-p file))
|
||||
(message "No session file at %S to read from" file))
|
||||
((require 'persp-mode nil t)
|
||||
(unless persp-mode
|
||||
(persp-mode +1))
|
||||
(let ((allowed (persp-list-persp-names-in-file file)))
|
||||
(cl-loop for name being the hash-keys of *persp-hash*
|
||||
unless (member name allowed)
|
||||
do (persp-kill name))
|
||||
(persp-load-state-from-file file)))
|
||||
((and (require 'frameset nil t)
|
||||
(require 'restart-emacs nil t))
|
||||
(restart-emacs--restore-frames-using-desktop file))
|
||||
((error "No session backend to load session with"))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/quickload-session ()
|
||||
"TODO"
|
||||
(interactive)
|
||||
(message "Restoring session...")
|
||||
(doom-load-session)
|
||||
(message "Session restored. Welcome back."))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/quicksave-session ()
|
||||
"TODO"
|
||||
(interactive)
|
||||
(message "Saving session")
|
||||
(doom-save-session)
|
||||
(message "Saving session...DONE"))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/load-session (file)
|
||||
"TODO"
|
||||
(interactive
|
||||
(let ((session-file (doom-session-file)))
|
||||
(list (or (read-file-name "Session to restore: "
|
||||
(file-name-directory session-file)
|
||||
(file-name-nondirectory session-file)
|
||||
t)
|
||||
(user-error "No session selected. Aborting")))))
|
||||
(unless file
|
||||
(error "No session file selected"))
|
||||
(message "Loading '%s' session" file)
|
||||
(doom-load-session file)
|
||||
(message "Session restored. Welcome back."))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/save-session (file)
|
||||
"TODO"
|
||||
(interactive
|
||||
(let ((session-file (doom-session-file)))
|
||||
(list (or (read-file-name "Save session to: "
|
||||
(file-name-directory session-file)
|
||||
(file-name-nondirectory session-file))
|
||||
(user-error "No session selected. Aborting")))))
|
||||
(unless file
|
||||
(error "No session file selected"))
|
||||
(message "Saving '%s' session" file)
|
||||
(doom-save-session file))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/restart ()
|
||||
"Restart Emacs (and the daemon, if active).
|
||||
|
||||
Unlike `doom/restart-and-restore', does not restart the current session."
|
||||
(interactive)
|
||||
(require 'restart-emacs)
|
||||
(restart-emacs))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/restart-and-restore (&optional debug)
|
||||
"Restart Emacs (and the daemon, if active).
|
||||
|
||||
If DEBUG (the prefix arg) is given, start the new instance with the --debug
|
||||
switch."
|
||||
(interactive "P")
|
||||
(require 'restart-emacs)
|
||||
(doom/quicksave-session)
|
||||
(save-some-buffers nil t)
|
||||
(letf! ((#'save-buffers-kill-emacs #'kill-emacs)
|
||||
(confirm-kill-emacs)
|
||||
(tmpfile (make-temp-file "post-load")))
|
||||
;; HACK `restart-emacs' does not properly escape arguments on Windows (in
|
||||
;; `restart-emacs--daemon-on-windows' and
|
||||
;; `restart-emacs--start-gui-on-windows'), so don't give it complex
|
||||
;; arguments at all. Should be fixed upstream, but restart-emacs seems to
|
||||
;; be unmaintained.
|
||||
(with-temp-file tmpfile
|
||||
(print `(progn
|
||||
(when (boundp 'doom-version)
|
||||
(add-hook 'window-setup-hook #'doom-load-session 100))
|
||||
(delete-file ,tmpfile))
|
||||
(current-buffer)))
|
||||
(restart-emacs
|
||||
(append (if debug (list "--debug-init"))
|
||||
(when (boundp 'chemacs-current-emacs-profile)
|
||||
(list "--with-profile" chemacs-current-emacs-profile))
|
||||
(list "-l" tmpfile)))))
|
||||
155
lisp/lib/store.el
Normal file
155
lisp/lib/store.el
Normal file
|
|
@ -0,0 +1,155 @@
|
|||
;;; lisp/lib/cache.el -*- lexical-binding: t; -*-
|
||||
|
||||
;; This little library abstracts the process of writing arbitrary elisp values
|
||||
;; to a 2-tiered file store (in `doom-store-dir'/`doom-store-location').
|
||||
|
||||
(defvar doom-store-dir (concat doom-etc-dir "store/")
|
||||
"Directory to look for and store data accessed through this API.")
|
||||
|
||||
(defvar doom-store-persist-alist ()
|
||||
"An alist of alists, containing lists of variables for the doom cache library
|
||||
to persist across Emacs sessions.")
|
||||
|
||||
(defvar doom-store-location "default"
|
||||
"The default location for cache files. This symbol is translated into a file
|
||||
name under `pcache-directory' (by default a subdirectory under
|
||||
`doom-store-dir'). One file may contain multiple cache entries.")
|
||||
|
||||
(defvar doom--store-table (make-hash-table :test 'equal))
|
||||
|
||||
(defun doom-save-persistent-store-h ()
|
||||
"Hook to persist `doom-store's storage when Emacs is killed."
|
||||
(let (locations)
|
||||
;; Persist `doom-store-persist-alist'
|
||||
(dolist (alist (butlast doom-store-persist-alist 1))
|
||||
(cl-loop with location = (car alist)
|
||||
for var in (cdr alist)
|
||||
do (doom-store-put var (symbol-value var) nil location 'noflush)
|
||||
and do (cl-pushnew location locations :test #'equal)))
|
||||
;; Clean up expired entries,
|
||||
(dolist (location (doom-files-in doom-store-dir :relative-to doom-store-dir))
|
||||
(maphash (lambda (key val)
|
||||
(when (doom--store-expired-p key val)
|
||||
(cl-pushnew location locations :test #'equal)
|
||||
(doom--store-rem key location 'noflush)))
|
||||
(doom--store-init location)))
|
||||
(mapc #'doom--store-flush locations)))
|
||||
(add-hook 'kill-emacs-hook #'doom-save-persistent-store-h)
|
||||
|
||||
|
||||
;;
|
||||
;;; Library
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-store-persist (location variables)
|
||||
"Persist VARIABLES (list of symbols) in LOCATION (symbol).
|
||||
This populates these variables with cached values, if one exists, and saves them
|
||||
to file when Emacs quits. This cannot persist buffer-local variables."
|
||||
(cl-check-type location string)
|
||||
(dolist (var variables)
|
||||
(when (doom-store-member-p var location)
|
||||
(set var (doom-store-get var location))))
|
||||
(setf (alist-get location doom-store-persist-alist)
|
||||
(append variables (alist-get location doom-store-persist-alist))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-store-desist (location &optional variables)
|
||||
"Unregisters VARIABLES (list of symbols) in LOCATION (symbol).
|
||||
Variables to persist are recorded in `doom-store-persist-alist'. Does not affect
|
||||
the actual variables themselves or their values."
|
||||
(cl-check-type location string)
|
||||
(if variables
|
||||
(setf (alist-get location doom-store-persist-alist)
|
||||
(cl-set-difference (cdr (assq location doom-store-persist-alist))
|
||||
variables))
|
||||
(delq! location doom-store-persist-alist 'assoc)))
|
||||
|
||||
(defun doom--store-init (&optional location)
|
||||
(cl-check-type location (or null string))
|
||||
(let ((location (or location doom-store-location)))
|
||||
(or (gethash location doom--store-table)
|
||||
(let* ((file-name-handler-alist nil)
|
||||
(location-path (expand-file-name location doom-store-dir)))
|
||||
(if (file-exists-p location-path)
|
||||
(puthash location
|
||||
(with-temp-buffer
|
||||
(set-buffer-multibyte nil)
|
||||
(setq buffer-file-coding-system 'binary)
|
||||
(insert-file-contents-literally location-path)
|
||||
(read (current-buffer)))
|
||||
doom--store-table)
|
||||
(puthash location (make-hash-table :test 'equal)
|
||||
doom--store-table))))))
|
||||
|
||||
(defun doom--store-expired-p (key data)
|
||||
(let ((ttl (car data)))
|
||||
(cond ((functionp ttl)
|
||||
(not (funcall ttl key data)))
|
||||
((consp ttl)
|
||||
(time-less-p ttl (current-time))))))
|
||||
|
||||
(defun doom--store-flush (location)
|
||||
"Write `doom--store-table' to `doom-store-dir'."
|
||||
(let ((file-name-handler-alist nil)
|
||||
(coding-system-for-write 'binary)
|
||||
(write-region-annotate-functions nil)
|
||||
(write-region-post-annotation-function nil))
|
||||
(let* ((location (or location doom-store-location))
|
||||
(data (doom--store-init location)))
|
||||
(make-directory doom-store-dir 'parents)
|
||||
(with-temp-file (expand-file-name location doom-store-dir)
|
||||
(prin1 data (current-buffer)))
|
||||
data)))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-store-get (key &optional location default-value noflush)
|
||||
"Retrieve KEY from LOCATION (defaults to `doom-store-location').
|
||||
If it doesn't exist or has expired, DEFAULT_VALUE is returned."
|
||||
(let ((data (gethash key (doom--store-init location) default-value)))
|
||||
(if (not (or (eq data default-value)
|
||||
(doom--store-expired-p key data)))
|
||||
(cdr data)
|
||||
(doom-store-rem key location noflush)
|
||||
default-value)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-store-put (key value &optional ttl location noflush)
|
||||
"Set KEY to VALUE in the store at LOCATION.
|
||||
KEY can be any lisp object that is comparable with `equal'. TTL is the duration
|
||||
(in seconds) after which this cache entry expires; if nil, no cache expiration.
|
||||
LOCATION is the super-key to store this cache item under. It defaults to
|
||||
`doom-store-location'."
|
||||
(cl-check-type ttl (or null integer function))
|
||||
(puthash key (cons (if (integerp ttl)
|
||||
(time-add (current-time) ttl)
|
||||
ttl)
|
||||
value)
|
||||
(doom--store-init location))
|
||||
(unless noflush
|
||||
(doom--store-flush location)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-store-rem (key &optional location noflush)
|
||||
"Clear a cache LOCATION (defaults to `doom-store-location')."
|
||||
(remhash key (doom--store-init location))
|
||||
(unless noflush
|
||||
(doom--store-flush location)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-store-member-p (key &optional location)
|
||||
"Return t if KEY in LOCATION exists.
|
||||
LOCATION defaults to `doom-store-location'."
|
||||
(let ((nil-value (format "--nilvalue%s--" (current-time))))
|
||||
(not (equal (doom-store-get key location nil-value)
|
||||
nil-value))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-store-clear (&optional location)
|
||||
"Clear the store at LOCATION (defaults to `doom-store-location')."
|
||||
(let* ((location (or location doom-store-location))
|
||||
(path (expand-file-name location doom-store-dir)))
|
||||
(remhash location doom--store-table)
|
||||
(when (file-exists-p path)
|
||||
(delete-file path)
|
||||
t)))
|
||||
108
lisp/lib/system.el
Normal file
108
lisp/lib/system.el
Normal file
|
|
@ -0,0 +1,108 @@
|
|||
;;; lisp/lib/system.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-system-distro ()
|
||||
"Return a symbol representing the installed distro."
|
||||
(cond (IS-WINDOWS 'windows)
|
||||
(IS-MAC 'macos)
|
||||
((and (file-exists-p "/etc/os-release")
|
||||
(with-temp-buffer
|
||||
(insert-file-contents "/etc/os-release")
|
||||
(when (re-search-forward "^ID=\"?\\([^\"\n]+\\)\"?" nil t)
|
||||
(intern (downcase (match-string 1)))))))
|
||||
;; A few redundancies in case os-release fails us
|
||||
((file-exists-p "/etc/debian_version")
|
||||
'debian)
|
||||
((executable-find "nixos-version")
|
||||
'nixos)
|
||||
((and (or (file-exists-p "/etc/config.scm")
|
||||
(file-directory-p "/run/current-system"))
|
||||
(executable-find "guix"))
|
||||
'guix)
|
||||
('linux)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-system-distro-version ()
|
||||
"Return a distro name and version string."
|
||||
(letf! (defun sh (&rest args) (cdr (apply #'doom-call-process args)))
|
||||
(let ((distro (doom-system-distro)))
|
||||
(cond
|
||||
((eq distro 'windows)
|
||||
(format "Windows %s" "Unknown")) ; TODO
|
||||
((eq distro 'macos)
|
||||
(format "MacOS %s" (sh "sw_vers" "-productVersion")))
|
||||
((executable-find "lsb_release")
|
||||
(sh "lsb_release" "-s" "-d"))
|
||||
((executable-find "nixos-version")
|
||||
(format "NixOS %s" (sh "nixos-version")))
|
||||
((and (file-exists-p "/etc/os-release")
|
||||
(with-temp-buffer
|
||||
(insert-file-contents "/etc/os-release")
|
||||
(when (re-search-forward "^PRETTY_NAME=\"?\\([^\"\n]+\\)\"?" nil t)
|
||||
(match-string 1)))))
|
||||
((when-let (files (doom-glob "/etc/*-release"))
|
||||
(truncate-string-to-width
|
||||
(replace-regexp-in-string "\n" " " (cat (car files) 73) nil t)
|
||||
64 nil nil "...")))
|
||||
((concat "Unknown " (sh "uname" "-v")))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-system-distro-icon ()
|
||||
"Display icon for the installed distro."
|
||||
(propertize
|
||||
(pcase (doom-system-distro)
|
||||
(`windows (all-the-icons-faicon "windows"))
|
||||
(`macos (all-the-icons-faicon "apple"))
|
||||
(`arch "\uF303")
|
||||
(`debian "\uF306")
|
||||
(`raspbian "\uF315")
|
||||
(`ubuntu "\uF31b")
|
||||
(`elementary "\uF309")
|
||||
(`fedora "\uF30a")
|
||||
(`coreos "\uF305")
|
||||
(`gentoo "\uF30d")
|
||||
(`mageia "\uF310")
|
||||
(`centos "\uF304")
|
||||
((or `opensuse `tumbleweed) "\uF314")
|
||||
(`sabayon "\uF317")
|
||||
(`slackware "\uF319")
|
||||
(`linuxmint "\uF30e")
|
||||
(`alpine "\uF300")
|
||||
(`aosc "\uF301")
|
||||
(`nixos "\uF313")
|
||||
(`devuan "\uF307")
|
||||
(`manjaro "\uF312")
|
||||
((or `void `artix) "\uF17c")
|
||||
(_ (all-the-icons-faicon "linux")))
|
||||
'face '(:height 1)
|
||||
'display '(raise 0)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-system-cpus ()
|
||||
"Return the max number of processing units on this system.
|
||||
Tries to be portable. Returns 1 if cannot be determined."
|
||||
(or (get 'doom-system-cpus 'cached-value)
|
||||
(put 'doom-system-cpus 'cached-value
|
||||
(let ((cpus
|
||||
(cond ((fboundp 'w32-get-nproc)
|
||||
(w32-get-nproc))
|
||||
((getenv "NUMBER_OF_PROCESSORS"))
|
||||
((executable-find "nproc")
|
||||
(doom-call-process "nproc"))
|
||||
((executable-find "sysctl")
|
||||
(doom-call-process "sysctl" "-n" "hw.ncpu")))))
|
||||
(max
|
||||
1 (or (cl-typecase cpus
|
||||
(integer cpus)
|
||||
(string
|
||||
(condition-case _
|
||||
(string-to-number cpus)
|
||||
(wrong-type-argument
|
||||
(user-error "NUMBER_OF_PROCESSORS contains an invalid value: %S"
|
||||
cpus))))
|
||||
(cons
|
||||
(if (zerop (car cpus))
|
||||
(string-to-number (cdr cpus))
|
||||
(user-error "Failed to look up number of processors, because:\n\n%s"
|
||||
(cdr cpus)))))
|
||||
1))))))
|
||||
350
lisp/lib/text.el
Normal file
350
lisp/lib/text.el
Normal file
|
|
@ -0,0 +1,350 @@
|
|||
;;; lisp/lib/text.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-point-in-comment-functions ()
|
||||
"List of functions to run to determine if point is in a comment.
|
||||
|
||||
Each function takes one argument: the position of the point. Stops on the first
|
||||
function to return non-nil. Used by `doom-point-in-comment-p'.")
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-point-in-string-functions ()
|
||||
"List of functions to run to determine if point is in a string.
|
||||
|
||||
Each function takes one argument: the position of the point. Stops on the first
|
||||
function to return non-nil. Used by `doom-point-in-string-p'.")
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-surrounded-p (pair &optional inline balanced)
|
||||
"Returns t if point is surrounded by a brace delimiter: {[(
|
||||
|
||||
If INLINE is non-nil, only returns t if braces are on the same line, and
|
||||
whitespace is balanced on either side of the cursor.
|
||||
|
||||
If INLINE is nil, returns t if the opening and closing braces are on adjacent
|
||||
lines, above and below, with only whitespace in between."
|
||||
(when pair
|
||||
(let ((beg (plist-get pair :beg))
|
||||
(end (plist-get pair :end))
|
||||
(pt (point)))
|
||||
(when (and (> pt beg) (< pt end))
|
||||
(when-let* ((cl (plist-get pair :cl))
|
||||
(op (plist-get pair :op)))
|
||||
(and (not (string= op ""))
|
||||
(not (string= cl ""))
|
||||
(let ((nbeg (+ (length op) beg))
|
||||
(nend (- end (length cl))))
|
||||
(let ((content (buffer-substring-no-properties nbeg nend)))
|
||||
(and (string-match-p (format "[ %s]*" (if inline "" "\n")) content)
|
||||
(or (not balanced)
|
||||
(= (- pt nbeg) (- nend pt))))))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-point-in-comment-p (&optional pos)
|
||||
"Return non-nil if POS is in a comment.
|
||||
POS defaults to the current position."
|
||||
(let ((pos (or pos (point))))
|
||||
(if doom-point-in-comment-functions
|
||||
(run-hook-with-args-until-success 'doom-point-in-comment-functions pos)
|
||||
(nth 4 (syntax-ppss pos)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-point-in-string-p (&optional pos)
|
||||
"Return non-nil if POS is in a string."
|
||||
;; REVIEW Should we cache `syntax-ppss'?
|
||||
(let ((pos (or pos (point))))
|
||||
(if doom-point-in-string-functions
|
||||
(run-hook-with-args-until-success 'doom-point-in-string-functions pos)
|
||||
(nth 3 (syntax-ppss pos)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-point-in-string-or-comment-p (&optional pos)
|
||||
"Return non-nil if POS is in a string or comment."
|
||||
(or (doom-point-in-string-p pos)
|
||||
(doom-point-in-comment-p pos)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-region-active-p ()
|
||||
"Return non-nil if selection is active.
|
||||
Detects evil visual mode as well."
|
||||
(declare (side-effect-free t))
|
||||
(or (use-region-p)
|
||||
(and (bound-and-true-p evil-local-mode)
|
||||
(evil-visual-state-p))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-region-beginning ()
|
||||
"Return beginning position of selection.
|
||||
Uses `evil-visual-beginning' if available."
|
||||
(declare (side-effect-free t))
|
||||
(or (and (bound-and-true-p evil-local-mode)
|
||||
(markerp evil-visual-beginning)
|
||||
(marker-position evil-visual-beginning))
|
||||
(region-beginning)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-region-end ()
|
||||
"Return end position of selection.
|
||||
Uses `evil-visual-end' if available."
|
||||
(declare (side-effect-free t))
|
||||
(if (bound-and-true-p evil-local-mode)
|
||||
evil-visual-end
|
||||
(region-end)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-thing-at-point-or-region (&optional thing prompt)
|
||||
"Grab the current selection, THING at point, or xref identifier at point.
|
||||
|
||||
Returns THING if it is a string. Otherwise, if nothing is found at point and
|
||||
PROMPT is non-nil, prompt for a string (if PROMPT is a string it'll be used as
|
||||
the prompting string). Returns nil if all else fails.
|
||||
|
||||
NOTE: Don't use THING for grabbing symbol-at-point. The xref fallback is smarter
|
||||
in some cases."
|
||||
(declare (side-effect-free t))
|
||||
(cond ((stringp thing)
|
||||
thing)
|
||||
((doom-region-active-p)
|
||||
(buffer-substring-no-properties
|
||||
(doom-region-beginning)
|
||||
(doom-region-end)))
|
||||
(thing
|
||||
(thing-at-point thing t))
|
||||
((require 'xref nil t)
|
||||
;; Eglot, nox (a fork of eglot), and elpy implementations for
|
||||
;; `xref-backend-identifier-at-point' betray the documented purpose of
|
||||
;; the interface. Eglot/nox return a hardcoded string and elpy prepends
|
||||
;; the line number to the symbol.
|
||||
(if (memq (xref-find-backend) '(eglot elpy nox))
|
||||
(thing-at-point 'symbol t)
|
||||
;; A little smarter than using `symbol-at-point', though in most
|
||||
;; cases, xref ends up using `symbol-at-point' anyway.
|
||||
(xref-backend-identifier-at-point (xref-find-backend))))
|
||||
(prompt
|
||||
(read-string (if (stringp prompt) prompt "")))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defun doom--bol-bot-eot-eol (&optional pos)
|
||||
(save-mark-and-excursion
|
||||
(when pos
|
||||
(goto-char pos))
|
||||
(let* ((bol (if visual-line-mode
|
||||
(save-excursion
|
||||
(beginning-of-visual-line)
|
||||
(point))
|
||||
(line-beginning-position)))
|
||||
(bot (save-excursion
|
||||
(goto-char bol)
|
||||
(skip-chars-forward " \t\r")
|
||||
(point)))
|
||||
(eol (if visual-line-mode
|
||||
(save-excursion (end-of-visual-line) (point))
|
||||
(line-end-position)))
|
||||
(eot (or (save-excursion
|
||||
(if (not comment-use-syntax)
|
||||
(progn
|
||||
(goto-char bol)
|
||||
(when (re-search-forward comment-start-skip eol t)
|
||||
(or (match-end 1) (match-beginning 0))))
|
||||
(goto-char eol)
|
||||
(while (and (doom-point-in-comment-p)
|
||||
(> (point) bol))
|
||||
(backward-char))
|
||||
(skip-chars-backward " " bol)
|
||||
(or (eq (char-after) 32)
|
||||
(eolp)
|
||||
(bolp)
|
||||
(forward-char))
|
||||
(point)))
|
||||
eol)))
|
||||
(list bol bot eot eol))))
|
||||
|
||||
(defvar doom--last-backward-pt nil)
|
||||
;;;###autoload
|
||||
(defun doom/backward-to-bol-or-indent (&optional point)
|
||||
"Jump between the indentation column (first non-whitespace character) and the
|
||||
beginning of the line. The opposite of
|
||||
`doom/forward-to-last-non-comment-or-eol'."
|
||||
(interactive "^d")
|
||||
(let ((pt (or point (point))))
|
||||
(cl-destructuring-bind (bol bot _eot _eol)
|
||||
(doom--bol-bot-eot-eol pt)
|
||||
(cond ((> pt bot)
|
||||
(goto-char bot))
|
||||
((= pt bol)
|
||||
(or (and doom--last-backward-pt
|
||||
(= (line-number-at-pos doom--last-backward-pt)
|
||||
(line-number-at-pos pt)))
|
||||
(setq doom--last-backward-pt nil))
|
||||
(goto-char (or doom--last-backward-pt bot))
|
||||
(setq doom--last-backward-pt nil))
|
||||
((<= pt bot)
|
||||
(setq doom--last-backward-pt pt)
|
||||
(goto-char bol))))))
|
||||
|
||||
(defvar doom--last-forward-pt nil)
|
||||
;;;###autoload
|
||||
(defun doom/forward-to-last-non-comment-or-eol (&optional point)
|
||||
"Jumps between the last non-blank, non-comment character in the line and the
|
||||
true end of the line. The opposite of `doom/backward-to-bol-or-indent'."
|
||||
(interactive "^d")
|
||||
(let ((pt (or point (point))))
|
||||
(cl-destructuring-bind (_bol _bot eot eol)
|
||||
(doom--bol-bot-eot-eol pt)
|
||||
(cond ((< pt eot)
|
||||
(goto-char eot))
|
||||
((= pt eol)
|
||||
(goto-char (or doom--last-forward-pt eot))
|
||||
(setq doom--last-forward-pt nil))
|
||||
((>= pt eot)
|
||||
(setq doom--last-backward-pt pt)
|
||||
(goto-char eol))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/backward-kill-to-bol-and-indent ()
|
||||
"Kill line to the first non-blank character. If invoked again afterwards, kill
|
||||
line to beginning of line. Same as `evil-delete-back-to-indentation'."
|
||||
(interactive)
|
||||
(let ((empty-line-p (save-excursion (beginning-of-line)
|
||||
(looking-at-p "[ \t]*$"))))
|
||||
(funcall (if (fboundp 'evil-delete)
|
||||
#'evil-delete
|
||||
#'delete-region)
|
||||
(point-at-bol) (point))
|
||||
(unless empty-line-p
|
||||
(indent-according-to-mode))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/delete-backward-word (arg)
|
||||
"Like `backward-kill-word', but doesn't affect the kill-ring."
|
||||
(interactive "p")
|
||||
(let (kill-ring)
|
||||
(ignore-errors (backward-kill-word arg))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/dumb-indent ()
|
||||
"Inserts a tab character (or spaces x tab-width)."
|
||||
(interactive)
|
||||
(if indent-tabs-mode
|
||||
(insert "\t")
|
||||
(let* ((movement (% (current-column) tab-width))
|
||||
(spaces (if (= 0 movement) tab-width (- tab-width movement))))
|
||||
(insert (make-string spaces ? )))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/dumb-dedent ()
|
||||
"Dedents the current line."
|
||||
(interactive)
|
||||
(if indent-tabs-mode
|
||||
(call-interactively #'backward-delete-char)
|
||||
(unless (bolp)
|
||||
(save-excursion
|
||||
(when (> (current-column) (current-indentation))
|
||||
(back-to-indentation))
|
||||
(let ((movement (% (current-column) tab-width)))
|
||||
(delete-char
|
||||
(- (if (= 0 movement)
|
||||
tab-width
|
||||
(- tab-width movement)))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/retab (arg &optional beg end)
|
||||
"Converts tabs-to-spaces or spaces-to-tabs within BEG and END (defaults to
|
||||
buffer start and end, to make indentation consistent. Which it does depends on
|
||||
the value of `indent-tab-mode'.
|
||||
|
||||
If ARG (universal argument) is non-nil, retab the current buffer using the
|
||||
opposite indentation style."
|
||||
(interactive "P\nr")
|
||||
(unless (and beg end)
|
||||
(setq beg (point-min)
|
||||
end (point-max)))
|
||||
(let ((indent-tabs-mode (if arg (not indent-tabs-mode) indent-tabs-mode)))
|
||||
(if indent-tabs-mode
|
||||
(tabify beg end)
|
||||
(untabify beg end))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/delete-trailing-newlines ()
|
||||
"Trim trailing newlines.
|
||||
|
||||
Respects `require-final-newline'."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(delete-blank-lines)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/dos2unix ()
|
||||
"Convert the current buffer to a Unix file encoding."
|
||||
(interactive)
|
||||
(set-buffer-file-coding-system 'undecided-unix nil))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/unix2dos ()
|
||||
"Convert the current buffer to a DOS file encoding."
|
||||
(interactive)
|
||||
(set-buffer-file-coding-system 'undecided-dos nil))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/toggle-indent-style ()
|
||||
"Switch between tabs and spaces indentation style in the current buffer."
|
||||
(interactive)
|
||||
(setq indent-tabs-mode (not indent-tabs-mode))
|
||||
(message "Indent style changed to %s" (if indent-tabs-mode "tabs" "spaces")))
|
||||
|
||||
(defvar editorconfig-lisp-use-default-indent)
|
||||
;;;###autoload
|
||||
(defun doom/set-indent-width (width)
|
||||
"Change the indentation size to WIDTH of the current buffer.
|
||||
|
||||
The effectiveness of this command is significantly improved if you have
|
||||
editorconfig or dtrt-indent installed."
|
||||
(interactive
|
||||
(list (if (integerp current-prefix-arg)
|
||||
current-prefix-arg
|
||||
(read-number "New indent size: "))))
|
||||
(setq tab-width width)
|
||||
(setq-local standard-indent width)
|
||||
(when (boundp 'evil-shift-width)
|
||||
(setq evil-shift-width width))
|
||||
(cond ((require 'editorconfig nil t)
|
||||
(let (editorconfig-lisp-use-default-indent)
|
||||
(editorconfig-set-indentation nil width)))
|
||||
((require 'dtrt-indent nil t)
|
||||
(when-let (vars (nth 2 (assq major-mode dtrt-indent-hook-mapping-list)))
|
||||
(dolist (var (doom-enlist vars))
|
||||
(doom-log "Updated %s = %d" var width)
|
||||
(set var width)))))
|
||||
(message "Changed indentation to %d" width))
|
||||
|
||||
|
||||
;;
|
||||
;;; Hooks
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-enable-delete-trailing-whitespace-h ()
|
||||
"Enables the automatic deletion of trailing whitespaces upon file save.
|
||||
|
||||
i.e. enables `ws-butler-mode' in the current buffer."
|
||||
(ws-butler-mode +1))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-disable-delete-trailing-whitespace-h ()
|
||||
"Disables the automatic deletion of trailing whitespaces upon file save.
|
||||
|
||||
i.e. disables `ws-butler-mode' in the current buffer."
|
||||
(ws-butler-mode -1))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-enable-show-trailing-whitespace-h ()
|
||||
"Enable `show-trailing-whitespace' in the current buffer."
|
||||
(setq-local show-trailing-whitespace t))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-disable-show-trailing-whitespace-h ()
|
||||
"Disable `show-trailing-whitespace' in the current buffer."
|
||||
(setq-local show-trailing-whitespace nil))
|
||||
109
lisp/lib/themes.el
Normal file
109
lisp/lib/themes.el
Normal file
|
|
@ -0,0 +1,109 @@
|
|||
;;; lisp/lib/themes.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;;###autoload
|
||||
(defconst doom-customize-theme-hook nil)
|
||||
|
||||
(add-hook! 'doom-load-theme-hook
|
||||
(defun doom-apply-customized-faces-h ()
|
||||
"Run `doom-customize-theme-hook'."
|
||||
(run-hooks 'doom-customize-theme-hook)))
|
||||
|
||||
(defun doom--custom-theme-set-face (spec)
|
||||
(cond ((listp (car spec))
|
||||
(cl-loop for face in (car spec)
|
||||
collect
|
||||
(car (doom--custom-theme-set-face (cons face (cdr spec))))))
|
||||
((keywordp (cadr spec))
|
||||
`((,(car spec) ((t ,(cdr spec))))))
|
||||
(`((,(car spec) ,(cdr spec))))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro custom-theme-set-faces! (theme &rest specs)
|
||||
"Apply a list of face SPECS as user customizations for THEME.
|
||||
|
||||
THEME can be a single symbol or list thereof. If nil, apply these settings to
|
||||
all themes. It will apply to all themes once they are loaded."
|
||||
(declare (indent defun))
|
||||
(let ((fn (gensym "doom--customize-themes-h-")))
|
||||
`(progn
|
||||
(defun ,fn ()
|
||||
(let (custom--inhibit-theme-enable)
|
||||
(dolist (theme (doom-enlist (or ,theme 'user)))
|
||||
(when (or (eq theme 'user)
|
||||
(custom-theme-enabled-p theme))
|
||||
(apply #'custom-theme-set-faces theme
|
||||
(mapcan #'doom--custom-theme-set-face
|
||||
(list ,@specs)))))))
|
||||
;; Apply the changes immediately if the user is using the default theme
|
||||
;; or the theme has already loaded. This allows you to evaluate these
|
||||
;; macros on the fly and customize your faces iteratively.
|
||||
(when (or (get 'doom-theme 'previous-themes)
|
||||
(null doom-theme))
|
||||
(funcall #',fn))
|
||||
;; FIXME Prevent clobbering this on-the-fly
|
||||
(add-hook 'doom-customize-theme-hook #',fn 100))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro custom-set-faces! (&rest specs)
|
||||
"Apply a list of face SPECS as user customizations.
|
||||
|
||||
This is a convenience macro alternative to `custom-set-face' which allows for a
|
||||
simplified face format, and takes care of load order issues, so you can use
|
||||
doom-themes' API without worry."
|
||||
(declare (indent defun))
|
||||
`(custom-theme-set-faces! 'user ,@specs))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/reload-theme ()
|
||||
"Reload the current Emacs theme."
|
||||
(interactive)
|
||||
(unless doom-theme
|
||||
(user-error "No theme is active"))
|
||||
(let ((themes (copy-sequence custom-enabled-themes)))
|
||||
(mapc #'disable-theme custom-enabled-themes)
|
||||
(let (doom-load-theme-hook)
|
||||
(mapc #'enable-theme (reverse themes)))
|
||||
(doom-run-hooks 'doom-load-theme-hook)
|
||||
(doom/reload-font)
|
||||
(message "%s %s"
|
||||
(propertize
|
||||
(format "Reloaded %d theme%s:"
|
||||
(length themes)
|
||||
(if (cdr themes) "s" ""))
|
||||
'face 'bold)
|
||||
(mapconcat #'prin1-to-string themes ", "))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-theme-face-attribute (theme face attribute &optional recursive)
|
||||
"Read a FACE's ATTRIBUTE for a loaded THEME.
|
||||
|
||||
This is different from `face-attribute', which reads the attribute of an active
|
||||
face for the current theme, but an active theme can change (or fail to load) in
|
||||
non-interactive or frame-less sessions."
|
||||
(let* ((spec
|
||||
(cl-loop for (type f _ spec) in (get theme 'theme-settings)
|
||||
if (and (eq type 'theme-face) (eq face f))
|
||||
return spec))
|
||||
(spec
|
||||
(letf! ((defun window-system (_frame) 'x)
|
||||
(defun display-color-cells (_frame) 257)
|
||||
(defun frame-parameter (frame parameter)
|
||||
(pcase parameter
|
||||
(`display-type 'color)
|
||||
(`background-mode 'dark)
|
||||
(_ (funcall frame-parameter frame parameter))))
|
||||
(#'display-supports-face-attributes-p #'always))
|
||||
(face-spec-choose spec)))
|
||||
(inherit (if recursive (plist-get spec :inherit)))
|
||||
(value (if (plist-member spec attribute)
|
||||
(plist-get spec attribute)
|
||||
'unspecified)))
|
||||
(when (and inherit (not (eq inherit 'unspecified)))
|
||||
(letf! (defun face-attribute (face attribute &optional _frame inherit)
|
||||
(doom-theme-face-attribute theme face attribute inherit))
|
||||
(setq value (face-attribute-merged-with attribute value inherit))))
|
||||
value))
|
||||
246
lisp/lib/ui.el
Normal file
246
lisp/lib/ui.el
Normal file
|
|
@ -0,0 +1,246 @@
|
|||
;;; lisp/lib/ui.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;
|
||||
;;; Public library
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-resize-window (window new-size &optional horizontal force-p)
|
||||
"Resize a window to NEW-SIZE. If HORIZONTAL, do it width-wise.
|
||||
If FORCE-P is omitted when `window-size-fixed' is non-nil, resizing will fail."
|
||||
(with-selected-window (or window (selected-window))
|
||||
(let ((window-size-fixed (unless force-p window-size-fixed)))
|
||||
(enlarge-window (- new-size (if horizontal (window-width) (window-height)))
|
||||
horizontal))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-quit-p (&optional prompt)
|
||||
"Prompt the user for confirmation when killing Emacs.
|
||||
|
||||
Returns t if it is safe to kill this session. Does not prompt if no real buffers
|
||||
are open."
|
||||
(or (not (ignore-errors (doom-real-buffer-list)))
|
||||
(yes-or-no-p (format "%s" (or prompt "Really quit Emacs?")))
|
||||
(ignore (message "Aborted"))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Advice
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-recenter-a (&rest _)
|
||||
"Generic advice for recentering window (typically :after other functions)."
|
||||
(recenter))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-preserve-window-position-a (fn &rest args)
|
||||
"Generic advice for preserving cursor position on screen after scrolling."
|
||||
(let ((row (cdr (posn-col-row (posn-at-point)))))
|
||||
(prog1 (apply fn args)
|
||||
(save-excursion
|
||||
(let ((target-row (- (line-number-at-pos) row)))
|
||||
(unless (< target-row 0)
|
||||
(evil-scroll-line-to-top target-row)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-shut-up-a (fn &rest args)
|
||||
"Generic advisor for silencing noisy functions.
|
||||
|
||||
In interactive Emacs, this just inhibits messages from appearing in the
|
||||
minibuffer. They are still logged to *Messages*.
|
||||
|
||||
In tty Emacs, messages are suppressed completely."
|
||||
(quiet! (apply fn args)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Hooks
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-apply-ansi-color-to-compilation-buffer-h ()
|
||||
"Applies ansi codes to the compilation buffers. Meant for
|
||||
`compilation-filter-hook'."
|
||||
(with-silent-modifications
|
||||
(ansi-color-apply-on-region compilation-filter-start (point))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-disable-show-paren-mode-h ()
|
||||
"Turn off `show-paren-mode' buffer-locally."
|
||||
(setq-local show-paren-mode nil))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-enable-line-numbers-h ()
|
||||
(display-line-numbers-mode +1))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-disable-line-numbers-h ()
|
||||
(display-line-numbers-mode -1))
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/toggle-line-numbers ()
|
||||
"Toggle line numbers.
|
||||
|
||||
Cycles through regular, relative and no line numbers. The order depends on what
|
||||
`display-line-numbers-type' is set to. If you're using Emacs 26+, and
|
||||
visual-line-mode is on, this skips relative and uses visual instead.
|
||||
|
||||
See `display-line-numbers' for what these values mean."
|
||||
(interactive)
|
||||
(defvar doom--line-number-style display-line-numbers-type)
|
||||
(let* ((styles `(t ,(if visual-line-mode 'visual 'relative) nil))
|
||||
(order (cons display-line-numbers-type (remq display-line-numbers-type styles)))
|
||||
(queue (memq doom--line-number-style order))
|
||||
(next (if (= (length queue) 1)
|
||||
(car order)
|
||||
(car (cdr queue)))))
|
||||
(setq doom--line-number-style next)
|
||||
(setq display-line-numbers next)
|
||||
(message "Switched to %s line numbers"
|
||||
(pcase next
|
||||
(`t "normal")
|
||||
(`nil "disabled")
|
||||
(_ (symbol-name next))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/delete-frame-with-prompt ()
|
||||
"Delete the current frame, but ask for confirmation if it isn't empty."
|
||||
(interactive)
|
||||
(if (cdr (frame-list))
|
||||
(when (doom-quit-p "Close frame?")
|
||||
(delete-frame))
|
||||
(save-buffers-kill-emacs)))
|
||||
|
||||
|
||||
(defun doom--enlargened-forget-last-wconf-h ()
|
||||
(set-frame-parameter nil 'doom--maximize-last-wconf nil)
|
||||
(set-frame-parameter nil 'doom--enlargen-last-wconf nil)
|
||||
(remove-hook 'doom-switch-window-hook #'doom--enlargened-forget-last-wconf-h))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/window-maximize-buffer (&optional arg)
|
||||
"Close other windows to focus on this one.
|
||||
Use `winner-undo' to undo this. Alternatively, use `doom/window-enlargen'."
|
||||
(interactive "P")
|
||||
(when (and (bound-and-true-p +popup-mode)
|
||||
(+popup-window-p))
|
||||
(+popup/raise (selected-window)))
|
||||
(delete-other-windows))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/window-enlargen (&optional arg)
|
||||
"Enlargen the current window (i.e. shrinks others) so you can focus on it.
|
||||
Use `winner-undo' to undo this. Alternatively, use
|
||||
`doom/window-maximize-buffer'."
|
||||
(interactive "P")
|
||||
(let* ((window (selected-window))
|
||||
(dedicated-p (window-dedicated-p window))
|
||||
(preserved-p (window-parameter window 'window-preserved-size))
|
||||
(ignore-window-parameters t)
|
||||
(window-resize-pixelwise nil)
|
||||
(frame-resize-pixelwise nil))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(when dedicated-p
|
||||
(set-window-dedicated-p window nil))
|
||||
(when preserved-p
|
||||
(set-window-parameter window 'window-preserved-size nil))
|
||||
(maximize-window window))
|
||||
(set-window-dedicated-p window dedicated-p)
|
||||
(when preserved-p
|
||||
(set-window-parameter window 'window-preserved-size preserved-p)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/window-maximize-horizontally ()
|
||||
"Delete all windows to the left and right of the current window."
|
||||
(interactive)
|
||||
(require 'windmove)
|
||||
(save-excursion
|
||||
(while (ignore-errors (windmove-left)) (delete-window))
|
||||
(while (ignore-errors (windmove-right)) (delete-window))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/window-maximize-vertically ()
|
||||
"Delete all windows above and below the current window."
|
||||
(interactive)
|
||||
(require 'windmove)
|
||||
(save-excursion
|
||||
(while (ignore-errors (windmove-up)) (delete-window))
|
||||
(while (ignore-errors (windmove-down)) (delete-window))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/set-frame-opacity (opacity)
|
||||
"Interactively change the current frame's opacity.
|
||||
|
||||
OPACITY is an integer between 0 to 100, inclusive."
|
||||
(interactive
|
||||
(list (read-number "Opacity (0-100): "
|
||||
(or (frame-parameter nil 'alpha)
|
||||
100))))
|
||||
(set-frame-parameter nil 'alpha opacity))
|
||||
|
||||
(defvar doom--narrowed-base-buffer nil)
|
||||
;;;###autoload
|
||||
(defun doom/narrow-buffer-indirectly (beg end)
|
||||
"Restrict editing in this buffer to the current region, indirectly.
|
||||
|
||||
This recursively creates indirect clones of the current buffer so that the
|
||||
narrowing doesn't affect other windows displaying the same buffer. Call
|
||||
`doom/widen-indirectly-narrowed-buffer' to undo it (incrementally).
|
||||
|
||||
Inspired from http://demonastery.org/2013/04/emacs-evil-narrow-region/"
|
||||
(interactive
|
||||
(list (or (bound-and-true-p evil-visual-beginning) (region-beginning))
|
||||
(or (bound-and-true-p evil-visual-end) (region-end))))
|
||||
(unless (region-active-p)
|
||||
(setq beg (line-beginning-position)
|
||||
end (line-end-position)))
|
||||
(deactivate-mark)
|
||||
(let ((orig-buffer (current-buffer)))
|
||||
(with-current-buffer (switch-to-buffer (clone-indirect-buffer nil nil))
|
||||
(narrow-to-region beg end)
|
||||
(setq-local doom--narrowed-base-buffer orig-buffer))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/widen-indirectly-narrowed-buffer (&optional arg)
|
||||
"Widens narrowed buffers.
|
||||
|
||||
This command will incrementally kill indirect buffers (under the assumption they
|
||||
were created by `doom/narrow-buffer-indirectly') and switch to their base
|
||||
buffer.
|
||||
|
||||
If ARG, then kill all indirect buffers, return the base buffer and widen it.
|
||||
|
||||
If the current buffer is not an indirect buffer, it is `widen'ed."
|
||||
(interactive "P")
|
||||
(unless (buffer-narrowed-p)
|
||||
(user-error "Buffer isn't narrowed"))
|
||||
(let ((orig-buffer (current-buffer))
|
||||
(base-buffer doom--narrowed-base-buffer))
|
||||
(cond ((or (not base-buffer)
|
||||
(not (buffer-live-p base-buffer)))
|
||||
(widen))
|
||||
(arg
|
||||
(let ((buffer orig-buffer)
|
||||
(buffers-to-kill (list orig-buffer)))
|
||||
(while (setq buffer (buffer-local-value 'doom--narrowed-base-buffer buffer))
|
||||
(push buffer buffers-to-kill))
|
||||
(switch-to-buffer (buffer-base-buffer))
|
||||
(mapc #'kill-buffer (remove (current-buffer) buffers-to-kill))))
|
||||
((switch-to-buffer base-buffer)
|
||||
(kill-buffer orig-buffer)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/toggle-narrow-buffer (beg end)
|
||||
"Narrow the buffer to BEG END. If narrowed, widen it."
|
||||
(interactive
|
||||
(list (or (bound-and-true-p evil-visual-beginning) (region-beginning))
|
||||
(or (bound-and-true-p evil-visual-end) (region-end))))
|
||||
(if (buffer-narrowed-p)
|
||||
(widen)
|
||||
(unless (region-active-p)
|
||||
(setq beg (line-beginning-position)
|
||||
end (line-end-position)))
|
||||
(narrow-to-region beg end)))
|
||||
52
lisp/packages.el
Normal file
52
lisp/packages.el
Normal file
|
|
@ -0,0 +1,52 @@
|
|||
;; -*- no-byte-compile: t; -*-
|
||||
;;; lisp/packages.el
|
||||
|
||||
;; doom.el
|
||||
(package! auto-minor-mode :pin "17cfa1b54800fdef2975c0c0531dad34846a5065")
|
||||
(package! gcmh :pin "0089f9c3a6d4e9a310d0791cf6fa8f35642ecfd9")
|
||||
(package! explain-pause-mode
|
||||
:recipe (:host github
|
||||
:repo "lastquestion/explain-pause-mode")
|
||||
:pin "2356c8c3639cbeeb9751744dbe737267849b4b51")
|
||||
|
||||
;; doom-packages.el
|
||||
(package! straight
|
||||
:type 'core
|
||||
:recipe `(:host github
|
||||
:repo "radian-software/straight.el"
|
||||
:branch ,straight-repository-branch
|
||||
:local-repo "straight.el"
|
||||
:files ("straight*.el"))
|
||||
:pin "fed215348076ba9182f634e0770a175220474b5a")
|
||||
|
||||
;; doom-modules.el
|
||||
(package! use-package
|
||||
:type 'core
|
||||
:pin "0ad5d9d5d8a61517a207ab04bf69e71c081149eb")
|
||||
|
||||
;; doom-ui.el
|
||||
(package! all-the-icons :pin "b18db6be0a290e8f91fd8d8340b2b44c8b75049a")
|
||||
(package! hide-mode-line :pin "bc5d293576c5e08c29e694078b96a5ed85631942")
|
||||
(package! highlight-numbers :pin "8b4744c7f46c72b1d3d599d4fb75ef8183dee307")
|
||||
(package! rainbow-delimiters :pin "a32b39bdfe6c61c322c37226d66e1b6d4f107ed0")
|
||||
(package! restart-emacs :pin "1607da2bc657fe05ae01f7fdf26f716eafead02c")
|
||||
|
||||
;; doom-editor.el
|
||||
(package! better-jumper :pin "47622213783ece37d5337dc28d33b530540fc319")
|
||||
(package! dtrt-indent :pin "d4fd1b4977eb0d534844fddf01c3c51c70c57205")
|
||||
(package! helpful :pin "94a07d49a80f66f8ebc54a49a4b4f6899a65fbe3")
|
||||
(package! pcre2el :pin "0b5b2a2c173aab3fd14aac6cf5e90ad3bf58fa7d")
|
||||
(package! smartparens :pin "8b6a3c3b31afd5b3f846e09859b5fc62eb06e7c1")
|
||||
(package! ws-butler
|
||||
;; Use my fork of ws-butler, which has a few choice improvements and
|
||||
;; optimizations (the original has been abandoned).
|
||||
:recipe (:host github :repo "hlissner/ws-butler")
|
||||
:pin "572a10c11b6cb88293de48acbb59a059d36f9ba5")
|
||||
|
||||
;; doom-projects.el
|
||||
(package! projectile :pin "dc6e7ff658789e4c6cf7c32a4b4fdf22ef9bc5a3")
|
||||
(package! project :pin "2e8da1b811d5213bd143d9d036bf7ea14741a1ae")
|
||||
|
||||
;; doom-keybinds.el
|
||||
(package! general :pin "9651024e7f40a8ac5c3f31f8675d3ebe2b667344")
|
||||
(package! which-key :pin "1ab1d0cc88843c9a614ed3226c5a1070e32e4823")
|
||||
Loading…
Add table
Add a link
Reference in a new issue