From 1399161e204062debf33b43d33bde1200caa0dc7 Mon Sep 17 00:00:00 2001
From: contrapunctus <contrapunctus@disroot.org>
Date: Mon, 15 Feb 2021 16:46:34 +0530
Subject: [PATCH] [cp-chronometrist] add tangling functions

---
 contrapunctus/cp-chronometrist.el | 39 +++++++++++++++++++++++++++++++
 1 file changed, 39 insertions(+)

diff --git a/contrapunctus/cp-chronometrist.el b/contrapunctus/cp-chronometrist.el
index 722d8c9..e5f1b2b 100644
--- a/contrapunctus/cp-chronometrist.el
+++ b/contrapunctus/cp-chronometrist.el
@@ -214,6 +214,45 @@ Return nil (and run `magit-status') if the user answers no."
       do (cl-incf count)
       finally do (message "%s" count))))
 
+;; Wrote these two as potential alternatives to `org-babel-tangle',
+;; which was far slower than I'd like (took around 20s for
+;; chronometrist.org when I checked during the migration process, and
+;; 43s after the migration was complete.) These, on the other hand,
+;; are almost instant, but I don't use them anywhere because I run a
+;; sed script as a file local variable.
+(defun chronometrist-tangle ()
+  (goto-char (point-min))
+  (cl-loop with source
+    while (not (eobp))
+    when (looking-at-p (rx (and line-start (zero-or-more blank) "#+BEGIN_SRC emacs-lisp" line-end)))
+    concat (progn
+             (forward-line 1)
+             (buffer-substring-no-properties
+              (point)
+              (cl-loop while (not (eobp))
+                if (looking-at-p (rx (and line-start
+                                          (zero-or-more blank)
+                                          "#+END_SRC"
+                                          line-end)))
+                do (cl-return (point))
+                else do (forward-line 1)))) into source
+    do (forward-line 1)
+    finally do
+    (with-current-buffer (find-file-noselect "chronometrist.el")
+      (delete-region (point-min) (point-max))
+      (insert source)
+      (save-buffer))))
+
+(defun chronometrist-tangle-sed ()
+  (let* ((file-path (buffer-file-name
+                     (current-buffer)))
+         (base      (file-name-base file-path)))
+    (when (equal "chronometrist.org" (file-name-nondirectory file-path))
+      (start-process-shell-command
+       "sed-tangle"
+       (generate-new-buffer-name "sed-tangle")
+       (format "sed -n '/#+BEGIN_SRC emacs-lisp$/,/#+END_SRC$/{//!p;}' ~s.org > ~s.el" base base)))))
+
 (provide 'cp-chronometrist)
 
 ;; Local Variables: