feat: footnotes

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*]

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, </p> 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 </p> 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!"))
 

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]