191 lines
8.2 KiB
EmacsLisp
191 lines
8.2 KiB
EmacsLisp
;;; config/literate/autoload.el -*- lexical-binding: t; -*-
|
|
|
|
;;;###autoload (add-hook 'org-mode-hook #'+literate-enable-recompile-h)
|
|
|
|
(defvar +literate-config-file (file-name-concat doom-user-dir "config.org")
|
|
"The file path of your literate config file.")
|
|
|
|
(defvar +literate-tangle--async-proc nil)
|
|
(defvar +literate-tangle--async-proc-start-time nil)
|
|
|
|
(defvar org-mode-hook)
|
|
(defvar org-inhibit-startup)
|
|
|
|
(defun +literate-tangle (target dest &optional dir)
|
|
"Tangle TARGET org file to DEST."
|
|
(and (require 'ox nil t)
|
|
(require 'ob-tangle nil t)
|
|
(let* ((default-directory (or dir default-directory))
|
|
(target (expand-file-name target))
|
|
(dest (expand-file-name dest)))
|
|
(print! (start "Tangling your literate config..."))
|
|
(print-group!
|
|
(let (;; Do as little unnecessary work as possible in these org files.
|
|
(org-startup-indented nil)
|
|
(org-startup-folded nil)
|
|
(vc-handled-backends nil)
|
|
;; Prevent unwanted entries in recentf, or formatters, or
|
|
;; anything that could be on these hooks, really. Nothing else
|
|
;; should be touching these files (particularly in interactive
|
|
;; sessions).
|
|
(write-file-functions nil)
|
|
(before-save-hook nil)
|
|
(after-save-hook nil)
|
|
;; Prevent infinite recursion due to recompile-on-save hooks
|
|
;; later, and speed up `org-mode' init.
|
|
(org-mode-hook nil)
|
|
(org-inhibit-startup t)
|
|
;; Allow evaluation of src blocks at tangle-time (would abort
|
|
;; them otherwise). This is a security hazard, but Doom will
|
|
;; trust that you know what you're doing!
|
|
(org-confirm-babel-evaluate nil)
|
|
;; Say a little more
|
|
(doom-print-message-level 'info))
|
|
(cond ((not (file-exists-p target))
|
|
(print! (warn "No org file at %s. Skipping...") (path target))
|
|
nil)
|
|
((with-temp-buffer
|
|
(insert-file-contents target)
|
|
(let ((case-fold-search t))
|
|
(not (re-search-forward "^ *#\\+begin_src e\\(?:macs-\\)?lisp" nil t))))
|
|
(print! (warn "No src blocks to tangle in %s. Skipping...") (path target))
|
|
nil)
|
|
((if-let (files (org-babel-tangle-file target dest))
|
|
(always (print! (success "Done tangling %d file(s)!" (length files))))
|
|
(print! (error "Failed to tangle any blocks from your config."))
|
|
nil))))))))
|
|
|
|
(defun +literate-tangle--sync ()
|
|
"Tangles `+literate-config-file' if it has changed."
|
|
(or (getenv "__NOTANGLE")
|
|
(and (+literate-tangle +literate-config-file
|
|
doom-module-config-file
|
|
doom-user-dir)
|
|
(or (not noninteractive)
|
|
(exit! "__NOTANGLE=1 $@")))))
|
|
|
|
(defun +literate-tangle--async ()
|
|
"Tangles `+literate-config-file' using an async Emacs process."
|
|
(unless (getenv "__NOTANGLE")
|
|
(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"
|
|
(with-current-buffer
|
|
(get-buffer-create " *tangle config*")
|
|
(erase-buffer)
|
|
(current-buffer))
|
|
"emacs" "--batch"
|
|
"-L" (file-name-directory (locate-library "org"))
|
|
"--load" (doom-path doom-core-dir "doom")
|
|
"--load" (doom-path doom-core-dir "lib/print")
|
|
"--eval"
|
|
(prin1-to-string
|
|
`(funcall #',(symbol-function #'+literate-tangle)
|
|
,+literate-config-file
|
|
,doom-module-config-file
|
|
,doom-user-dir))))
|
|
(add-hook 'kill-emacs-hook #'+literate-tangle-check-finished-h)
|
|
(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) '(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))))
|
|
|
|
|
|
;;
|
|
;;; Commands
|
|
|
|
;;;###autoload
|
|
(defalias '+literate/reload #'doom/reload)
|
|
|
|
(defun +literate--flatten-imenu-index (index &optional prefix)
|
|
"Flatten an org-mode imenu index."
|
|
(let ((flattened '()))
|
|
(dolist (item index flattened)
|
|
(let* ((name (propertize (car item) 'face (intern (format "org-level-%d" (if prefix (+ 2 (cl-count ?/ prefix)) 1)))))
|
|
(prefix (if prefix (concat prefix "/" name) name)))
|
|
(if (imenu--subalist-p item)
|
|
(setq flattened (append flattened (+literate--flatten-imenu-index (cdr item) prefix)))
|
|
(push (cons prefix (cdr item)) flattened))))
|
|
(nreverse flattened)))
|
|
|
|
(defvar imenu-auto-rescan)
|
|
;;;###autoload
|
|
(defun +literate/find-heading (&optional level)
|
|
"Jump to a heading in your literate org config file."
|
|
(interactive "P")
|
|
(let* ((buffer (or (find-buffer-visiting +literate-config-file)
|
|
(find-file-noselect +literate-config-file t))))
|
|
(with-current-buffer buffer
|
|
(let* ((imenu-auto-rescan t)
|
|
(org-imenu-depth (or level 8))
|
|
(index (+literate--flatten-imenu-index (imenu--make-index-alist))))
|
|
(let ((c (current-window-configuration))
|
|
(result nil))
|
|
(unwind-protect
|
|
(progn
|
|
(switch-to-buffer buffer)
|
|
(if (modulep! :completion vertico)
|
|
(setq result (consult-outline level))
|
|
(let ((entry (assoc (completing-read "Go to heading: " index nil t) index)))
|
|
(setq result entry)
|
|
(imenu entry))))
|
|
(unless result
|
|
(set-window-configuration c))))))))
|
|
|
|
|
|
;;
|
|
;;; Hooks
|
|
|
|
;;;###autoload
|
|
(defun +literate-tangle-h ()
|
|
"Tangles `+literate-config-file' if it has changed.
|
|
This is performed with an asyncronous Emacs process, except when
|
|
`noninteractive' is nil."
|
|
(if noninteractive
|
|
(unless (+literate-tangle--sync)
|
|
(kill-emacs 3))
|
|
(+literate-tangle--async)))
|
|
|
|
;;;###autoload
|
|
(defun +literate-tangle-check-finished-h ()
|
|
"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)))
|
|
|
|
;;;###autoload
|
|
(defun +literate-enable-recompile-h ()
|
|
"Enable literate-compiling-on-save in the current buffer."
|
|
(add-hook 'after-save-hook #'+literate-recompile-maybe-h nil 'local))
|
|
|
|
;;;###autoload
|
|
(defun +literate-recompile-maybe-h ()
|
|
"Recompile literate config to `doom-user-dir'.
|
|
|
|
We assume any org file in `doom-user-dir' is connected to your literate config,
|
|
and should trigger a recompile if changed."
|
|
(and (file-in-directory-p
|
|
(buffer-file-name (buffer-base-buffer))
|
|
(file-name-directory (file-truename +literate-config-file)))
|
|
(+literate-tangle-h)))
|
|
|
|
;;; autoload.el ends here
|