feat(literate): add async config tangling
This commit is contained in:
parent
a65e97bf2c
commit
8df91f0b33
1 changed files with 70 additions and 0 deletions
|
@ -9,6 +9,9 @@
|
||||||
"The file path that `+literate-config-file' will be tangled to, then
|
"The file path that `+literate-config-file' will be tangled to, then
|
||||||
byte-compiled from.")
|
byte-compiled from.")
|
||||||
|
|
||||||
|
(defvar +literate-tangle--async-proc nil)
|
||||||
|
(defvar +literate-tangle--async-proc-start-time nil)
|
||||||
|
|
||||||
(defvar org-mode-hook)
|
(defvar org-mode-hook)
|
||||||
(defvar org-inhibit-startup)
|
(defvar org-inhibit-startup)
|
||||||
|
|
||||||
|
@ -16,6 +19,73 @@ byte-compiled from.")
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun +literate-tangle-h ()
|
(defun +literate-tangle-h ()
|
||||||
|
"Tangles `+literate-config-file' if it has changed.
|
||||||
|
This is performed with an asyncronous Emacs process, except when
|
||||||
|
`doom-interactive-p' is non-nil."
|
||||||
|
(if doom-interactive-p
|
||||||
|
(+literate-tangle--async)
|
||||||
|
(+literate-tangle--sync)))
|
||||||
|
|
||||||
|
(defun +literate-tangle--async ()
|
||||||
|
"Tangles `+literate-config-file' using an async Emacs process."
|
||||||
|
(unless (getenv "__NOTANGLE")
|
||||||
|
(let ((default-directory doom-private-dir)
|
||||||
|
(target +literate-config-file)
|
||||||
|
(cache +literate-config-cache-file)
|
||||||
|
(dest (expand-file-name (concat doom-module-config-file ".el"))))
|
||||||
|
(when +literate-tangle--async-proc
|
||||||
|
(message "Killing outdated tangle process...")
|
||||||
|
(set-process-sentinel +literate-tangle--async-proc #'ignore)
|
||||||
|
(kill-process +literate-tangle--async-proc)
|
||||||
|
(sit-for 0.3)) ; ensure the message is seen for a bit
|
||||||
|
(setq +literate-tangle--async-proc-start-time (float-time)
|
||||||
|
+literate-tangle--async-proc
|
||||||
|
;; See `+literate-tangle--sync' for an explanation of the (progn ...) below.
|
||||||
|
(start-process "tangle-config"
|
||||||
|
(get-buffer-create " *tangle config*")
|
||||||
|
"emacs" "--batch" "--eval"
|
||||||
|
(format "(progn \
|
||||||
|
(require 'ox) \
|
||||||
|
(require 'ob-tangle) \
|
||||||
|
(setq org-startup-indented nil \
|
||||||
|
org-startup-folded nil \
|
||||||
|
vc-handled-backends nil \
|
||||||
|
write-file-functions nil \
|
||||||
|
before-save-hook nil \
|
||||||
|
after-save-hook nil \
|
||||||
|
org-mode-hook nil \
|
||||||
|
org-inhibit-startup t \
|
||||||
|
org-confirm-babel-evaluate nil) \
|
||||||
|
(org-babel-tangle-file %S %S) \
|
||||||
|
(with-temp-file %S) \
|
||||||
|
)" target dest cache)))
|
||||||
|
(set-process-sentinel +literate-tangle--async-proc #'+literate-tangle--async-sentinel)
|
||||||
|
(run-at-time nil nil (lambda () (message "Tangling config.org"))) ; ensure shown after a save message
|
||||||
|
"Tangling config.org...")))
|
||||||
|
|
||||||
|
(defun +literate-tangle--async-sentinel (process signal)
|
||||||
|
(cond
|
||||||
|
((and (eq 'exit (process-status process))
|
||||||
|
(= 0 (process-exit-status process)))
|
||||||
|
(message "Tangled config.org sucessfully (took %.1fs)"
|
||||||
|
(- (float-time) +literate-tangle--async-proc-start-time))
|
||||||
|
(setq +literate-tangle--async-proc nil))
|
||||||
|
((memq (process-status process) (list 'exit 'signal))
|
||||||
|
(pop-to-buffer (get-buffer " *tangle config*"))
|
||||||
|
(message "Failed to tangle config.org (after %.1fs)"
|
||||||
|
(- (float-time) +literate-tangle--async-proc-start-time))
|
||||||
|
(setq +literate-tangle--async-proc nil))))
|
||||||
|
|
||||||
|
(defun +literate-tangle-check-finished ()
|
||||||
|
"When a tangle is still in progress, ask the user if they want to wait for it."
|
||||||
|
(when (and (process-live-p +literate-tangle--async-proc)
|
||||||
|
(yes-or-no-p "Config is currently retangling, would you please wait a few seconds?"))
|
||||||
|
(switch-to-buffer " *tangle config*")
|
||||||
|
(signal 'quit nil)))
|
||||||
|
|
||||||
|
(add-hook! 'kill-emacs-hook #'+literate-tangle-check-finished)
|
||||||
|
|
||||||
|
(defun +literate-tangle--sync ()
|
||||||
"Tangles `+literate-config-file' if it has changed."
|
"Tangles `+literate-config-file' if it has changed."
|
||||||
(and (not (getenv "__NOTANGLE"))
|
(and (not (getenv "__NOTANGLE"))
|
||||||
(require 'ox nil t)
|
(require 'ox nil t)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue