Implement source code origin links

1 files changed, 29 insertions, 0 deletions

diff --git a/jakob/utils/org-mode.scm b/jakob/utils/org-mode.scm
index 8da8b39..89e07bb 100644
--- a/jakob/utils/org-mode.scm
+++ b/jakob/utils/org-mode.scm
@@ -197,6 +197,7 @@ daemon. Assumes that FORM does not write to `standard-output'."
 (define (rewrite-org-mode tree)
   (define filters (list rewrite-absolute-urls-as-relative
                         rewrite-code-blocks-as-figures
+                        rewrite-source-code-origin
                         rewrite-table-of-contents))
   (fold (lambda (f value) (f value)) tree filters))
 
@@ -233,3 +234,31 @@ daemon. Assumes that FORM does not write to `standard-output'."
     ((xs ...)
      (map rewrite-table-of-contents xs))
     (elem elem)))
+
+(define (rewrite-source-code-origin tree)
+  (match tree
+    (('figure
+      ('@ ('class "code-container"))
+      ('figcaption
+       ('@ ('class "code-header"))
+       _)
+      ('pre
+       ('code
+        (('span ('@ ('class "org-comment-delimiter")) _comment-delimiter-1)
+         ('span ('@ ('class "org-comment")) origin-text)
+         "\n"
+         ('span ('@ ('class "org-comment-delimiter")) _comment-delimiter-2)
+         ('span ('@ ('class "org-comment"))
+            (and origin-href
+                 (? (cut string-prefix? "http" <>) origin-href))) "\n"
+         code-rest ...))))
+     `(figure
+       (@ (class "code-container"))
+       (figcaption
+        (@ (class "code-header"))
+        (span (@ (class "code-filename"))
+          (a (@ (href ,origin-href)) ,origin-text)))
+       (pre (code ,@code-rest))))
+    ((xs ...)
+     (map rewrite-source-code-origin xs))
+    (elem elem)))