Various site updates

2 files changed, 63 insertions, 1 deletions

diff --git a/jakob/utils/features.scm b/jakob/utils/features.scm
new file mode 100644
index 0000000..4dc66db
--- /dev/null
+++ b/jakob/utils/features.scm
@@ -0,0 +1,24 @@
+;;; Copyright © 2019 - 2025 Jakob L. Kreuze <zerodaysfordays@sdf.org>
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation; either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (jakob utils features)
+  #:export (feature-enabled?))
+
+(define %feature-condition-alist
+  `((food-gallery . ,(lambda () (getenv "HAUNT_INCLUDE_FOOD_GALLERY")))))
+
+(define (feature-enabled? key)
+  ((assq-ref %feature-condition-alist key)))
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)))