From b27db6e710fac95a84d347e52fc8464e4a1047a1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Madeleine=20Sydney=20=C5=9Alaga?= Date: Fri, 6 Feb 2026 17:56:41 -0700 Subject: [PATCH] feat: footnotes --- doerg/src/net/deertopia/doerg/element.clj | 90 +++++++++++++++--- doerg/src/net/deertopia/doerg/render.clj | 108 +++++++++++++++++----- doerg/src/net/deertopia/doerg/repl.clj | 2 +- 3 files changed, 166 insertions(+), 34 deletions(-) diff --git a/doerg/src/net/deertopia/doerg/element.clj b/doerg/src/net/deertopia/doerg/element.clj index a683f8b..65c1781 100644 --- a/doerg/src/net/deertopia/doerg/element.clj +++ b/doerg/src/net/deertopia/doerg/element.clj @@ -8,7 +8,9 @@ [clojure.spec.alpha :as s] [spec-dict.main :refer [dict]] [net.deertopia.doerg.config :as cfg] - [com.rpl.specter :as sp]) + [com.rpl.specter :as sp] + [clojure.tools.logging.readable :as lr]) + (:import (java.util UUID)) (:refer-clojure :exclude [read-string])) @@ -64,7 +66,7 @@ ;; Not 100% sure if this is a valid definition. It seems that ;; Uniorg sets `:children` to an empty vector when a great element ;; lacks children. - (contains? e :children)) + (and (map? e) (contains? e :children))) (defn org-element? [element] #_ @@ -82,6 +84,15 @@ (contains? (into #{} (cons type types)) (:type element)))) +(defn of-keyword-type? [element key] + (and (of-type? element "keyword") + (= (:key element) key))) + +(defn footnotes-section? [element] + (and (of-type? element "section") + (when-some [footnotes-headline (first (:children element))] + (= "Footnotes" (:raw-value footnotes-headline))))) + ;;; Spec @@ -113,20 +124,77 @@ (sp/continue-then-stay children-walker p) sp/STAY))) +(def postorder-walker* + (sp/recursive-path + [] p + (sp/if-path greater-element? + (sp/continue-then-stay :children p) + sp/STAY))) + ;;; Post-processing -#_ -(defn doerg-data-node? [node] - (of-type? node )) +(def property-handlers + "A map of node-property keys to functions. The functions will be + called with two arguments: the pre-existing top-level document data + (a map), and the node-property value. The function is expected to + return the document data map with the new property merged in." + {"ID" (fn [data id] + (let [new-id (UUID/fromString id)] + (when (contains? data :id) + (lr/warnf (str "Found multiple :ID: definitions." + " Replacing %s with %s.") + (:id data) new-id)) + (assoc data :id new-id))) + "DeertopiaVisibility" + (fn [data visibility] + (let [v (case visibility + "public" :public + "private" :private + "graphonly" :graph-only + (do (lr/warn "Unknown visibility: %s" visibility) + :private))] + (assoc data :net.deertopia/visibility v)))}) -#_ -(defn gather-doerg-data [loc] - (assert (of-type? (z/node loc) "org-data") - "`gather-doerg-data` should be applied to the document root.") - (->> loc z/children (split-with doerg-data-node?))) +(def keyword-handlers + "Like `property-handlers`, but for top-level keywords." + {"TITLE" #(assoc %1 :title %2)}) -(defn- split-sections [nodes] +(defn- apply-handlers [handlers values] + (reduce (fn [data {:keys [key value]}] + (let [f (get handlers key)] + (f data value))) + {} + values)) + +(defn handle-properties [doc] + (let [props (some-> doc :children first)] + (when (of-type? props "property-drawer") + (->> props + (sp/select [children-walker + #(contains? property-handlers (:key %))]) + (apply-handlers property-handlers))))) + +(defn handle-keywords [doc] + (->> doc + (sp/select [children-walker + #(and (of-type? % "keyword") + (contains? keyword-handlers (:key %)))]) + (apply-handlers keyword-handlers))) + +(defn gather-doerg-data [doc] + (assoc doc :net.deertopia.doerg/data + (merge (handle-properties doc) + (handle-keywords doc)))) + +(defn- split-sections + "Given a list of top-level nodes as spat out by the `uniorg` + parser, return a map with the following keys + • :top-level-nodes The nodes that /should/ be at the top-level. + • :first-section-nodes The nodes that should be wrapped in a new + section node + • :rest Everything else!" + [nodes] (let [[of-top-level remaining-nodes] (->> nodes (split-with #(of-type? % "property-drawer" "keyword"))) [of-first-section remaining-nodes*] diff --git a/doerg/src/net/deertopia/doerg/render.clj b/doerg/src/net/deertopia/doerg/render.clj index 2213ee0..1ad75c2 100644 --- a/doerg/src/net/deertopia/doerg/render.clj +++ b/doerg/src/net/deertopia/doerg/render.clj @@ -42,7 +42,9 @@ (defn org-element-recursive "Recursively render an Org-mode element to Hiccup." [e] - (->> e (sp/transform + (->> e + ;; gather-footnotes + (sp/transform [element/postorder-walker view-children-as-seq] (fn [node] (try (org-element node) @@ -53,16 +55,14 @@ (defn org-document "Recursively render an Org-mode document to Hiccup." [doc] - (let [loc (element/doerg-zip doc)] - (binding [*document-info* {:footnotes (gather-footnotes loc)}] - (let [rendered (org-element-recursive doc)] - [:html - [:head - [:title "org document"] - doerg-html/head] - [:body - [:article - rendered]]])))) + (let [rendered (org-element-recursive (gather-footnotes doc))] + [:html + [:head + [:title "org document"] + doerg-html/head] + [:body + [:article + rendered]]])) ;;; Further dispatching on `org-element` @@ -83,8 +83,52 @@ (sp/view #(update % :children seq)) sp/STAY)) -(defn- gather-footnotes [loc] - {}) +#_ +(defn- gather-footnotes [doc] + (->> doc + (sp/select + [element/children-walker element/footnotes-section? + element/children-walker + #(element/of-type? % "footnote-definition") + (sp/view (fn [d] + {(:label d) d}))]) + (apply merge))) + +(defn- contains-footnote-refs? [node] + (some #(element/of-type? % "footnote-reference") + (:children node))) + +(defn- gather-footnotes + "Traverse document and reposition footnote-definitions to + immediately follow their first references. Removes the footnotes + section from the document." + [doc] + (let [fn-defs (->> doc + (sp/select + [element/children-walker element/footnotes-section? + element/children-walker + #(element/of-type? % "footnote-definition") + (sp/view (fn [d] + {(:label d) d}))]) + (apply merge)) + encountered (atom #{})] + (->> doc + (sp/transform + [element/postorder-walker + contains-footnote-refs?] + (fn [node] + (assoc node :children + (->> (for [n (:children node)] + (let [label (:label n)] + (if (and (element/of-type? n "footnote-reference") + (not (@encountered label))) + (do (swap! encountered #(conj % label)) + (list n (get fn-defs label))) + (list n)))) + (apply concat))))) + (sp/setval [element/children-walker + element/footnotes-section?] + sp/NONE)))) @@ -119,6 +163,17 @@ :dd (apply vector :dd dds)} _ nil)) +;; In HTML5,

tags cannot be nested for… reasons. In fact, no +;; block-level elements are allowed within paragraphs. This stupid +;; hack works around that restriction by stripping

tags }:). +(defn- strip-paragraphs [elements] + (apply concat + (for [x elements] + (match x + [:p (_ :guard map?) & xs] (seq xs) + [:p & xs] (seq xs) + _ x)))) + (defn- render-renderer-error @@ -146,23 +201,29 @@ (defmethod org-element "bold" [{:keys [children]}] [:b children]) -(defmethod org-element "section" [{:keys [children]}] - [:section - (or (seq children) - [:div.empty-section-message "This section is empty…"])]) +(defmethod org-element "code" [{:keys [value]}] + [:code value]) + +(defmethod org-element "section" [{:keys [children] + :as section}] + (when-not (element/footnotes-section? section) + [:section + (or (seq children) + [:div.empty-section-message "This section is empty…"])])) (defmethod org-element "headline" [{:keys [children level]}] [(level->tag level) children]) (defmethod org-element "footnote-reference" - [{:keys [label children]}] + [{:keys [label]}] ;; FIXME: This will break if there are multiple references to a ;; single footnote, since `label` is assumed to be unique. (list [:label.margin-toggle.sidenote-number {:for label}] [:input.margin-toggle {:type "checkbox" - :id label}] - [:span.sidenote - "«todo: footnote here lol»"])) + :id label}])) + +(defmethod org-element "footnote-definition" [{:keys [children]}] + [:span.sidenote (strip-paragraphs children)]) (defmethod org-element "plain-list" [{:keys [list-type children]}] (let [tag (case list-type @@ -192,13 +253,16 @@ (defmethod org-keyword "TITLE" [{:keys [value]}] [:h1 value]) +;; Completely ignore the LATEX_COMPILER keyword. +(defmethod org-keyword "LATEX_COMPILER" [_] nil) + (defmethod org-element :default [x] (render-pprint x :text "unimplemented!")) -#_#_ (defmethod org-keyword :default [x] (render-pprint x :text "unimplemented!")) +#_ (defmethod org-special-block :default [x] (render-pprint x :text "unimplemented!")) diff --git a/doerg/src/net/deertopia/doerg/repl.clj b/doerg/src/net/deertopia/doerg/repl.clj index dc59a48..072a18f 100644 --- a/doerg/src/net/deertopia/doerg/repl.clj +++ b/doerg/src/net/deertopia/doerg/repl.clj @@ -8,8 +8,8 @@ [babashka.fs :as fs])) (def some-org-file - "/home/msyds/org/20251228003307-prerequisite_context_in_korean.org" #_ + "/home/msyds/org/20251228003307-prerequisite_context_in_korean.org" "/home/msyds/org/20251111182118-path_induction.org") (defn- force-create-sym-link [path target]