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

refactor: introduce doom-module-context

Browse source 
Where f9201eb introduced a general context system, this one introduces
one for modules, to simplify our let-bind game when interacting with
modules, and to more efficiently expose module state to modulep! (which
gets called at runtime a great deal, so its performance is important).

* lisp/doom-lib.el (doom-log): simplify macro and introduce
  doom-inhibit-log variable.
* lisp/doom-modules.el (modulep!): fix reported file path if modulep!
  fails to find the local module.
* lisp/lib/debug.el (doom-debug-variables): disable doom-inhibit-log
  when debug mode is on.

Ref: f9201eb218
This commit is contained in:
Henrik Lissner 2022-09-24 20:34:13 +02:00
parent 5d2313155c
commit 4efaf6837b
No known key found for this signature in database
GPG key ID: B60957CA074D39A3
8 changed files with 118 additions and 72 deletions
Download patch file Download diff file Expand all files Collapse all files

33
lisp/cli/doctor.el
View file

@ -242,23 +242,22 @@ in."
(let (doom-doctor--errors (let (doom-doctor--errors
doom-doctor--warnings) doom-doctor--warnings)
(condition-case-unless-debug ex (condition-case-unless-debug ex
(let ((doom--current-module key) (doom-module-context-with key
(doom--current-flags (plist-get plist :flags)) (let ((doctor-file (doom-module-expand-path (car key) (cdr key) "doctor.el"))
(doctor-file (doom-module-expand-path (car key) (cdr key) "doctor.el")) (packages-file (doom-module-expand-path (car key) (cdr key) doom-module-packages-file)))
(packages-file (doom-module-expand-path (car key) (cdr key) doom-module-packages-file))) (cl-loop with doom-output-indent = 6
(cl-loop with doom-output-indent = 6 for name in (doom-context-with 'packages
for name in (doom-context-with 'packages (let* (doom-packages
(let* (doom-packages doom-disabled-packages)
doom-disabled-packages) (load packages-file 'noerror 'nomessage)
(load packages-file 'noerror 'nomessage) (mapcar #'car doom-packages)))
(mapcar #'car doom-packages))) unless (or (doom-package-get name :disable)
unless (or (doom-package-get name :disable) (eval (doom-package-get name :ignore))
(eval (doom-package-get name :ignore)) (plist-member (doom-package-get name :recipe) :local-repo)
(plist-member (doom-package-get name :recipe) :local-repo) (locate-library (symbol-name name))
(locate-library (symbol-name name)) (doom-package-built-in-p name)
(doom-package-built-in-p name) (doom-package-installed-p name))
(doom-package-installed-p name)) do (print! (error "Missing emacs package: %S") name))))
do (print! (error "Missing emacs package: %S") name)))
(let ((inhibit-message t)) (let ((inhibit-message t))
(load doctor-file 'noerror 'nomessage)) (load doctor-file 'noerror 'nomessage))
(file-missing (error! "%s" (error-message-string ex))) (file-missing (error! "%s" (error-message-string ex)))

39
lisp/doom-lib.el
View file

@ -17,29 +17,34 @@
;; ;;
;;; Logging ;;; Logging
(defun doom--log (text) (defvar doom-inhibit-log (not (or noninteractive init-file-debug))
(let ((inhibit-message (not init-file-debug))) "If non-nil, suppress `doom-log' output.")
(message "%s" (propertize text 'face 'font-lock-doc-face))))
(defmacro doom-log (output &rest args) (defun doom--log (text &rest args)
(let ((inhibit-message (not init-file-debug))
(absolute? (string-prefix-p ":" text)))
(apply #'message
(propertize (concat "* %.06f:%s" (if (not absolute?) ":") text)
'face 'font-lock-doc-face)
(float-time (time-subtract (current-time) before-init-time))
(mapconcat
(lambda (x) (format "%s" x))
(unless absolute?
(append (cons '* (remq t (reverse doom-context)))
(if (bound-and-true-p doom-module-context)
(let ((key (doom-module-context-key)))
(delq nil (list (car key) (cdr key)))))))
":")
args)))
(defmacro doom-log (message &rest args)
"Log a message in *Messages*. "Log a message in *Messages*.
Does not emit the message in the echo area. This is a macro instead of a Does not emit the message in the echo area. This is a macro instead of a
function to prevent the potentially expensive evaluation of its arguments when function to prevent the potentially expensive evaluation of its arguments when
debug mode is off." debug mode is off. Return non-nil."
(declare (debug t)) (declare (debug t))
`(when (or init-file-debug noninteractive) `(unless doom-inhibit-log (doom--log ,message ,@args)))
(doom--log
(with-no-warnings ; suppress 'more args than %-sequences' warning
(let* ((output ,output)
(absolute? (string-prefix-p ":" output)))
(format (concat "* %.06f%s" (if absolute? output (concat ":" output)))
(float-time (time-subtract (current-time) before-init-time))
(let ((context (remq t (reverse doom-context))))
(if (and context (not absolute?))
(concat "::" (mapconcat #'symbol-name context ":"))
""))
,@args))))))
;; ;;

76
lisp/doom-modules.el
View file

@ -107,8 +107,56 @@ your `doom!' block, a warning is emitted before replacing it with :emacs vc and
:group 'doom :group 'doom
:type 'hook) :type 'hook)
(defvar doom--current-module nil)
(defvar doom--current-flags nil) ;;
;;; `doom-module-context'
(defvar doom-module-context [nil nil nil nil]
"A vector describing the module associated it with the active context.
Contains the following: [:GROUP MODULE FLAGS FEATURES]
Do not directly set this variable, only let-bind it.")
(eval-and-compile
(setplist 'doom-module-context '(group 0 name 1 flags 2 features 3)))
;; DEPRECATED: Remove this when byte-compilation is introduced to Doom core.
(defmacro doom-module--context-field (field) (get 'doom-module-context field))
(defun doom-module-context-get (field &optional context)
"Return the FIELD of CONTEXT.
FIELD should be one of `group', `name', `flags', or `features'.
CONTEXT should be a `doom-module-context' vector. If omitted, defaults to
`doom-module-context'."
(aref (or context doom-module-context) (get 'doom-module-context field)))
(defun doom-module-context (group &optional name)
"Create a `doom-module-context' from a module by GROUP and NAME.
If NAME is omitted, GROUP is treated as a module key cons cell: (GROUP . NAME)."
(declare (side-effect-free t))
(let* ((key (if name (cons group name) group))
(group (or (car-safe key) key))
(name (cdr-safe key))
(data (get group name)))
(vector group name
(aref data (doom-module--context-field flags))
(aref data (doom-module--context-field features)))))
(defun doom-module-context-key (&optional context)
"Return the module of the active `doom-module-context' as a module key."
(declare (side-effect-free t))
(let ((context (or context doom-module-context)))
(cons (aref context (doom-module--context-field group))
(aref context (doom-module--context-field name)))))
(defmacro doom-module-context-with (module-key &rest body)
"Evaluate BODY with `doom-module-context' informed by MODULE-KEY."
(declare (indent 1))
`(let ((doom-module-context (doom-module-context ,module-key)))
(doom-log ":context:module: =%s" doom-module-context)
,@body))
;; ;;
@ -418,19 +466,17 @@ For more about modules and flags, see `doom!'."
;; Doom will byte-compile its core files. At that time, we can use it again. ;; Doom will byte-compile its core files. At that time, we can use it again.
(and (cond (flag (memq flag (aref (or (get category module) doom--empty-module) 2))) (and (cond (flag (memq flag (aref (or (get category module) doom--empty-module) 2)))
(module (get category module)) (module (get category module))
(doom--current-flags (memq category doom--current-flags)) (doom-module-context (memq category (aref doom-module-context 2)))
(doom--current-module ((let ((file
(memq category ;; This must be expanded at the call site, not in
(aref (or (get (car doom--current-module) ;; `modulep!'s definition, to get the file we want.
(cdr doom--current-module)) (macroexpand '(file!))))
doom--empty-module) (if-let (module (doom-module-from-path file))
2))) (memq category (aref (or (get (car module) (cdr module))
((if-let (module (doom-module-from-path (macroexpand '(file!)))) doom--empty-module)
(memq category (aref (or (get (car module) (cdr module)) 2))
doom--empty-module) (error "(modulep! %s %s %s) couldn't figure out what module it was called from (in %s)"
2)) category module flag file)))))
(error "(modulep! %s %s %s) couldn't figure out what module it was called from (in %s)"
category module flag (file!)))))
t)) t))

26
lisp/doom-packages.el
View file

@ -411,13 +411,9 @@ installed."
;;; Package getters ;;; Package getters
(defun doom-packages--read (file &optional noeval noerror) (defun doom-packages--read (file &optional noeval noerror)
(doom-context-with 'packages (doom-context-with 'packages
(condition-case-unless-debug e (doom-module-context-with (doom-module-from-path file)
(with-temp-buffer ; prevent buffer-local state from propagating (condition-case-unless-debug e
(let* ((doom--current-module (doom-module-from-path file)) (with-temp-buffer ; prevent buffer-local state from propagating
(doom--current-flags
(doom-module-get (car doom--current-module)
(cdr doom--current-module)
:flags)))
(if (not noeval) (if (not noeval)
(load file noerror 'nomessage 'nosuffix) (load file noerror 'nomessage 'nosuffix)
(when (file-exists-p file) (when (file-exists-p file)
@ -436,14 +432,14 @@ installed."
(push (cons (push (cons
name (plist-put name (plist-put
plist :modules plist :modules
(list doom--current-module))) (list (doom-module-context-key))))
doom-packages))))))))) doom-packages))))))))
(user-error (user-error
(user-error (error-message-string e))) (user-error (error-message-string e)))
(error (error
(signal 'doom-package-error (signal 'doom-package-error
(list (doom-module-from-path file) (list (doom-module-context-key)
file e)))))) file e)))))))
(defun doom-package-list (&optional module-list) (defun doom-package-list (&optional module-list)
"Retrieve a list of explicitly declared packages from MODULE-LIST. "Retrieve a list of explicitly declared packages from MODULE-LIST.

6
lisp/doom-profiles.el
View file

@ -399,9 +399,9 @@ Defaults to the profile at `doom-profile-default'."
(init-file doom-module-init-file) (init-file doom-module-init-file)
(config-file doom-module-config-file)) (config-file doom-module-config-file))
(letf! ((defun module-loader (group name file &optional noerror) (letf! ((defun module-loader (group name file &optional noerror)
`(let ((doom--current-module '(,group . ,name)) (doom-module-context-with (cons group name)
(doom--current-flags ',(doom-module-get group name :flags))) `(let ((doom-module-context ,doom-module-context))
(doom-load ,(abbreviate-file-name (file-name-sans-extension file))))) (doom-load ,(abbreviate-file-name (file-name-sans-extension file))))))
(defun module-list-loader (modules file &optional noerror) (defun module-list-loader (modules file &optional noerror)
(cl-loop for (cat . mod) in modules (cl-loop for (cat . mod) in modules
if (doom-module-locate-path cat mod file) if (doom-module-locate-path cat mod file)

1
lisp/lib/debug.el
View file

@ -9,6 +9,7 @@
(defvar doom-debug-variables (defvar doom-debug-variables
`(;; Doom variables `(;; Doom variables
(doom-print-minimum-level . debug) (doom-print-minimum-level . debug)
(doom-inhibit-log . nil)
;; Emacs variables ;; Emacs variables
async-debug async-debug

7
lisp/lib/files.el
View file

@ -155,10 +155,9 @@ return NULL-VALUE."
(insert-file-contents file nil 0 256) (insert-file-contents file nil 0 256)
(if (re-search-forward (format "^;;;###%s " (regexp-quote (or cookie "if"))) (if (re-search-forward (format "^;;;###%s " (regexp-quote (or cookie "if")))
nil t) nil t)
(let* ((load-file-name file) (doom-module-context-with (doom-module-from-path file)
(doom--current-module (doom-module-from-path file)) (let ((load-file-name file))
(doom--current-flags (doom-module-get (car doom--current-module) (cdr doom--current-module) :flags))) (eval (sexp-at-point) t)))
(eval (sexp-at-point) t))
null-value))) null-value)))
;;;###autoload ;;;###autoload

2
modules/lang/org/config.el
View file

@ -1351,7 +1351,7 @@ between the two."
)) ))
;;; Custom org modules ;;; Custom org modules
(dolist (flag doom--current-flags) (dolist (flag (doom-module-context-get 'flags))
(load! (concat "contrib/" (substring (symbol-name flag) 1)) nil t)) (load! (concat "contrib/" (substring (symbol-name flag) 1)) nil t))
;; Add our general hooks after the submodules, so that any hooks the ;; Add our general hooks after the submodules, so that any hooks the