Various site updates

1 files changed, 39 insertions, 1 deletions

diff --git a/jakob/utils/sxml.scm b/jakob/utils/sxml.scm
index 0fc34d2..5ab08a9 100644
--- a/jakob/utils/sxml.scm
+++ b/jakob/utils/sxml.scm
@@ -23,7 +23,8 @@
             script
 
             sanitize-subtree
-            rewrite-absolute-urls-as-relative))
+            rewrite-absolute-urls-as-relative
+            flatten-section-headings))
 
 
 ;;;
@@ -89,3 +90,40 @@ sanitize the resultant subtree."
     ((xs ...)
      (map rewrite-absolute-urls-as-relative xs))
     (elem elem)))
+
+(define (flatten-section-headings tree)
+  """Flattens extraneous sections output by Org-mode
+
+This function traverses a SXML tree and removes the outermost `<div>`
+elements that represent Org-mode section headings.
+
+Args:
+  tree: A SXML tree.
+
+Returns:
+  A SXML tree with the outermost Org section heading `<div>` elements
+removed and their contents flattened.
+  """
+  (define (flatten-section-headings-inner tree)
+    (define (is-org-section form)
+      (match form
+        ((or ('div ('@ ('id id) ('class _))
+                   rest ...)
+             ('div ('@ ('id id))
+                   rest ...)
+             ('div ('@ ('role "doc-footnote") ('class id))
+                   rest ...))
+         (or (string=? "footpara" id)
+             (string-prefix? "text-footnotes" id)
+             (string-prefix? "outline-container-org" id)
+             (string-prefix? "text-org" id)))
+        (_ #f)))
+    (match tree
+      ((? is-org-section
+          ('div ('@ _ ...)
+                rest ...))
+       (append-map flatten-section-headings-inner rest))
+      ((xs ...)
+       (list (append-map flatten-section-headings-inner xs)))
+      (elem (list elem))))
+  (first (flatten-section-headings-inner tree)))