fix: tikz svgs

Fixes #9

doerg/default.nix

@@ -7,7 +7,6 @@
 , fake-git
 , our-tex ? callPackage ./our-tex.nix {}
 , makeWrapper
-, breakpointHook
 }:
 
 let
@@ -38,7 +37,6 @@ in mkCljBin' {
   nativeBuildInputs = [
     plex
     makeWrapper
-    breakpointHook
   ];
   buildInputs = [
     doerg-parser

doerg/doerg-temml-worker/README.org

@@ -1 +1,12 @@
 #+title: doerg-temml-worker
+
+This is a tiny Node script that is used by doerg. For each CBOR-encoded value on stdin (a "command"), a response value is spit to stdout.
+
+Currently, the following commands are supported:
+- Any string: Return the Temml-rendered MathML code as a string (inline).
+- An array with a single string element: Return the Temml-rendered MathML code as a string (display).
+If something goes wrong, either of these commands may return an object of form
+#+begin_src json
+  {"type": "error"
+  ,"error": «error object»}
+#+end_src

doerg/our-tex.nix

@@ -39,5 +39,6 @@ texlive.combine {
     collection-fontsrecommended # Essential fonts.
     etoolbox # For Org-mode exports.
     caption
+    standalone
   ;
 }

doerg/resources/net/deertopia/doerg/preview-template.tex

@@ -1,11 +1,56 @@
-\documentclass{article}
-\usepackage{amsmath}
+\documentclass[tikz,dvisvgm]{standalone}
 \usepackage[active,tightpage,auctex,dvips]{preview}
-\usepackage{fontspec}
+\usepackage{amsmath}
+\usepackage{amssymb}
 \usepackage{ifxetex}
 \usepackage{syd-plex}
+\usepackage{quiver}
+\usepackage{tikz}
+\usepackage{amscd}
+
+\newcommand{\catname}[1]{\textbf{#1}}
+\newcommand{\C}[1]{\catname{#1}}
+
+% Specific categories
+\newcommand{\Set}{\catname{Set}}
+\newcommand{\Cat}{\catname{Cat}}
+\newcommand{\CAT}{\catname{CAT}}
+\newcommand{\Grp}{\catname{Grp}}
+
+% Common objects and functions
+\newcommand{\Ob}{\operatorname{Ob}}
+\newcommand{\op}{\text{op}}
+\newcommand{\opof}[1]{{#1}^{\text{op}}}
+% \id{x} is the identity morphism on x.
+\newcommand{\id}[1]{1_{#1}}
+% \Id{C} is the identity functor on C.
+\newcommand{\Id}[1]{1_{#1}}
+\newcommand{\Mor}{\operatorname{Mor}}
+\newcommand{\homset}[3]{{{#1} \left[ {#2} \to {#3} \right]}}
+
+% Constructions of categories.
+\newcommand{\FunctorCategory}[2]{\left[#1, #2\right]}
+\newcommand{\Funct}[2]{\FunctorCategory{#1}{#2}} % Deprecated.
+\newcommand{\ArrowCategory}[1]{{#1}^\to}
+
+% Semantic aliases
+\newcommand{\monicto}{\rightarrowtail}
+\newcommand{\epicto}{\twoheadrightarrow}
+\newcommand{\naturalto}{\Rightarrow}
+\newcommand{\isoto}{\cong}
+\newcommand{\equivto}{\simeq}
+
+\newcommand{\naturaltrans}[2]{#1 \naturalto #2} % Deprecated.
+\newcommand{\horizontalcompose}{\ast}
+
+% Optics
+\newcommand{\opticname}[1]{\textbf{#1}}
+\newcommand{\optic}[3]{\opticname{#1}^\prime\;#2\;#3}
+\newcommand{\Optic}[5]{\opticname{#1}\;#2\;#3\;#4\;#5}
 
 \begin{document}
-\setlength\abovedisplayskip{0pt}
+\setlength\abovedisplayskip{0pt} % Remove padding before equation environments.
+%% \color[rgb]{0.000,0.000,0.004}\special{dvisvgm:currentcolor on}\setcounter{equation}{0}%
+
 % {{contents}}
 \end{document}

doerg/src/net/deertopia/doerg/render.clj

@@ -12,7 +12,7 @@
             ;; #_
             [net.deertopia.doerg.tex :as tex]
             ;; [net.deertopia.doerg.tex.native :as tex-native]
-            ;; [net.deertopia.doerg.tex.temml :as tex-temml]
+            [net.deertopia.doerg.tex.temml :as tex-temml]
             [clojure.zip :as z]
             [babashka.fs :as fs]))
 
@@ -143,6 +143,19 @@
          #(element/of-keyword-type? % "LATEX_HEADER")
          (sp/view :value)])))
 
+(defn- timeout-snippet-promises [snippet-promises fut]
+  ;; Time out after twenty seconds. With all the LaTeX and IPC, there
+  ;; are so many opportunities for things to go wrong </3.
+  (let [ms (* 20 1000)
+        fut-res (deref fut ms ::timed-out)]
+    (if (= fut-res ::timed-out)
+      (do (l/warnf "Giving up on rendering TeX snippets after %.3f seconds."
+                   (/ ms 1000))
+          (future-cancel fut)
+          (doseq [[_snippet p] snippet-promises]
+            (deliver p ::timed-out)))
+      fut-res)))
+
 (defn render-tex-snippets
   "Traverse doc, adorning each LaTeX node with a promise resolving to,
   optimistically, Hiccup-rendered SVG or MathML code."
@@ -156,21 +169,12 @@
                       (let [p (promise)]
                         (swap! snippet-promises #(conj % [(:value node) p]))
                         (assoc node ::rendered p)))))
-        fut (-> #(tex/render-snippets @snippet-promises)
+        sp @snippet-promises
+        fut (-> #(tex/render-snippets sp)
                 bound-fn* future-call)]
-    ;; Time out after eight seconds. With all the LaTeX and IPC, there
-    ;; are so many opportunities for things to go wrong </3.
-    (let [fut-res (deref fut (* 10 1000) ::timed-out)]
-      (if (= fut-res ::timed-out)
-        (do (future-cancel fut)
-            (doseq [[_snippet p] @snippet-promises]
-              (deliver p ::timed-out)))
-        fut-res))
+    (timeout-snippet-promises sp fut)
     r))
 
-(comment
- (render-tex-snippets doc))
-
 
 
 (defn- render-pprint

doerg/src/net/deertopia/doerg/repl.clj

@@ -14,11 +14,14 @@
   "/home/msyds/org/20250919114912-homepage.org"
   #_
   "/home/msyds/org/20251111182118-path_induction.org"
-  #_
+  ;; #_
   "/home/msyds/org/20250512144715-natural_transformation_category_theory.org"
   #_
   "/home/msyds/org/20251021155921-path_action.org"
-  "test/net/deertopia/doerg/render_test/fallbacks.org")
+  #_
+  "test/net/deertopia/doerg/render_test/fallbacks.org"
+  #_
+  "/home/msyds/org/20250910115311-men_who_would_make_stunning_dykes.org")
 
 (defn- force-create-sym-link [path target]
   (fs/delete-if-exists path)

doerg/src/net/deertopia/doerg/tex.clj

@@ -4,7 +4,8 @@
             [babashka.fs :as fs]
             [clojure.string :as str]
             [hiccup2.core :as hiccup]
-            [clojure.tools.logging :as l]))
+            [clojure.tools.logging :as l]
+            [clojure.tools.logging.readable :as lr]))
 
 (defn- read-and-patch-generated-svg [{:keys [file height depth]}]
   ;; dvisvgm writes standalone SVG files, to which we need to make a
@@ -28,28 +29,38 @@
          (format "%s style=\"%s\""
                  s
                  (format "height:%.4fem;vertical-align:%.4fem;display:inline-block"
-                         height (- depth)))))))
+                         height (- depth)))))
+      ;; Stupid hack. --currentcolor on dvisvgm should be enough, but
+      ;; it doesn't get e.g. TikZ arrows.
+      (str/replace #"stroke=['\"]#000['\"]" "stroke=\"currentColor\"")))
+
+(def ^:dynamic *save-snippets?* false)
 
 (defn render-snippets [snippet-promises]
-  (fs/with-temp-dir [svg-dir {:prefix "doerg-svg-"}]
-    (let [rendered-snippets
-          (delay (->> snippet-promises
-                      (map first)
-                      (apply native/render svg-dir)))]
-      (doseq [[snippet p] snippet-promises]
-        (try (let [temml (temml/render snippet)]
-               (if (temml/erroneous-output? temml)
-                 (let [tex (get @rendered-snippets snippet)]
-                   (if (:errors tex)
-                     (deliver p (hiccup/raw temml))
-                     (->> tex
-                          read-and-patch-generated-svg
-                          hiccup/raw
-                          (deliver p))))
-                 (deliver p (hiccup/raw temml))))
-             (catch Exception e
-               (l/error e "Error in TeX thread")
-               (throw e)))))))
+  (with-redefs [fs/delete-tree
+                (fn
+                  ([path]
+                   (l/warnf "refusing to delete %s" path))
+                  ([path opts]
+                   (lr/warnf "refusing to delete %s with opts %s"
+                             path opts)))]
+    (fs/with-temp-dir [svg-dir {:prefix "doerg-svg-"}]
+      (let [rendered-snippets
+            (delay (->> snippet-promises
+                        (map first)
+                        (apply native/render svg-dir)))]
+        (doseq [[snippet p] snippet-promises]
+          (try (let [temml (temml/render snippet)]
+                 (->> (if (temml/erroneous-output? temml)
+                        (let [tex (get @rendered-snippets snippet)]
+                          (if (:errors tex)
+                            temml
+                            (read-and-patch-generated-svg tex)))
+                        temml)
+                      hiccup/raw (deliver p)))
+               (catch Exception e
+                 (l/error e "Error in TeX thread")
+                 (throw e))))))))
 
 (comment
   (let [snippets (for [x ["\\(\\ifxetex blah \\fi\\)"

doerg/src/net/deertopia/doerg/tex/native.clj

@@ -93,7 +93,7 @@
     (invoke
      {:dir output-dir}
      dvisvgm "--page=1-" "--optimize" "--clipjoin"
-     "--relative" "--no-fonts" "-v3"
+     "--relative" "--no-fonts" "-v3" "--currentcolor"
      "--message=processing page {?pageno}: output written to {?svgpath}"
      "--bbox=preview" "-o" "%9p.svg" file)))
 

doerg/src/net/deertopia/doerg/tex/temml.clj

@@ -55,15 +55,18 @@
   (command-worker [s]))
 
 (defn render [s]
-  (if-let [[_ inner] (re-matches #"(?s)\\[(.*)\\]" s)]
-    (render-display inner)
-    (if (re-matches #"(?s)\\begin\{.+?}(.*?)\\end\{.+?}" s)
-      (render-display s)
-      (if-let [[_ inner] (re-matches #"(?s)\\\((.*)\\\)" s)]
-        (render-inline inner)
-        (throw (IllegalArgumentException.
-                (str "`net.deertopia.doerg.tex.temml` argument should"
-                     " be enclosed in math delimiters.")))))))
+  (let [s (str/trim s)]
+    (if-let [[_ inner] (re-matches #"(?s)\\\[(.*)\\]" s)]
+      (render-display inner)
+      (if (re-matches #"(?s)\\begin\{.+?}(.*?)\\end\{.+?}" s)
+        (render-display s)
+        (if-let [[_ inner] (re-matches #"(?s)\\\((.*)\\\)" s)]
+          (render-inline inner)
+          (throw (IllegalArgumentException.
+                  (ex-info
+                   (str "`net.deertopia.doerg.tex.temml` argument should"
+                        " be enclosed in math delimiters.")
+                   {:arg s}))))))))
 
 ;; hackky....
 (defn erroneous-output? [s]