fix: tikz svgs

Fixes #9

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

@@ -150,7 +150,7 @@
         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))
+                   (/ ms 1000))
           (future-cancel fut)
           (doseq [[_snippet p] snippet-promises]
             (deliver p ::timed-out)))

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,26 +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)
-                          temml
-                          (read-and-patch-generated-svg tex)))
-                      temml)
-                    hiccup/raw (deliver p)))
-             (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)))