doerg/doerg-tex/index.js

@@ -34,7 +34,7 @@ function do_command (cmd) {
 	    return null
 	}
     } catch (e) {
-	return e
+	return {type: "error", error: e}
     }
 }
 

doerg/resources/net/deertopia/doerg/prelude.tex

@@ -141,6 +141,7 @@
 \newcommand{\definedto}{≔}
 \newcommand{\equivto}{\simeq}
 \newcommand{\homotopicto}{\sim}
+\newcommand{\homotopyto}{\sim}
 \newcommand{\naturalto}{\Rightarrow}
 \newcommand{\isoto}{\cong}
 \newcommand{\monicto}{\rightarrowtail}

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

@@ -0,0 +1,10 @@
+\documentclass{article}
+\usepackage{amsmath}
+\usepackage[active,tightpage,auctex,dvips]{preview}
+\usepackage{fontspec}
+%% \usepackage{syd-plex}
+
+\begin{document}
+\setlength\abovedisplayskip{0pt}
+% {{contents}}
+\end{document}

doerg/src/net/deertopia/doerg/common.clj

@@ -1,6 +1,12 @@
 (ns net.deertopia.doerg.common
   (:require [babashka.process :as p]
-            [clojure.string :as str]))
+            [clojure.string :as str]
+            [clojure.tools.logging :as l]
+            [clojure.java.io :as io])
+  (:import (java.io FilterInputStream StringWriter InputStream
+                    OutputStream PrintStream ByteArrayOutputStream
+                    ByteArrayInputStream FilterOutputStream)
+           (java.nio.charset StandardCharsets)))
 
 (defn deref-with-timeout [process ms]
   (let [p (promise)
@@ -16,3 +22,104 @@
                       {:process process
                        :timed-out-after-milliseconds ms}))
       @p)))
+
+(defn tee-input-stream
+  "Return a wrapped `InputStream` that writes all bytes read from
+  input-stream to sink, à la the UNIX command tee(1)."
+  [input-stream sink]
+  (proxy [FilterInputStream] [input-stream]
+    (read
+      ([]
+       (let [c (proxy-super read)]
+         (when (not= c -1)
+           (.write sink c))
+         c))
+      ([^bytes bs]
+       (let [n (proxy-super read bs)]
+         (when (not= n -1)
+           (.write sink bs 0 n))
+         n))
+      ([^bytes bs off len]
+       (let [n (proxy-super read bs off len)]
+         (when (not= n -1)
+           (.write sink bs off n))
+         n)))
+    (close []
+      (try (proxy-super close)
+           (finally (.close sink))))))
+
+(defn tee-output-stream
+  "Return a wrapped `OutputStream` that writes all bytes written to
+  output-stream to sink, à la the UNIX command tee(1)."
+  [output-stream sink]
+  (proxy [FilterOutputStream] [output-stream]
+    (write
+      ([bs-or-b]
+       (proxy-super write bs-or-b)
+       (.write sink bs-or-b))
+      ([^bytes bs off len]
+       (proxy-super write bs off len)
+       (.write sink bs off len)))
+    (close []
+      (try (proxy-super close)
+           (finally (.close sink))))))
+
+#_
+(defn hook-input-stream [input-stream hook]
+  (proxy [FilterInputStream] [input-stream]
+    (read
+      ([]
+       (let [c (proxy-super read)]
+         (when (not= c -1)
+           (hook (byte-array [c])))
+         c))
+      ([^bytes bs]
+       (let [n (proxy-super read bs)]
+         (when (not= n -1)
+           (let [bs* (byte-array n 0)]
+             (System/arraycopy bs 0 bs* 0 n)
+             (hook bs*)))
+         n))
+      ([^bytes bs off len]
+       (let [n (proxy-super read bs off len)]
+         (when (not= n -1)
+           (.write sink bs off n))
+         n)))
+    (close []
+      (try (proxy-super close)
+           (finally (.close sink))))))
+
+(comment
+  (with-open [sink (ByteArrayOutputStream.)
+              out (ByteArrayOutputStream.)
+              in (ByteArrayInputStream. (.getBytes "hello worms"))]
+    (io/copy (tee-input-stream in sink) out)
+    (def the-out out)
+    (def the-sink sink)
+    {:out out
+     :sink sink})
+  (with-open [sink (l/log-stream :info "blah")
+              out (ByteArrayOutputStream.)
+              in (ByteArrayInputStream. (.getBytes "hello worms"))]
+    (io/copy (tee-input-stream in sink) out)
+    (def the-out out)
+    (def the-sink sink)
+    {:out out
+     :sink sink}))
+
+(comment
+  (let [out (ByteArrayOutputStream.)]
+    (p/shell {:out (tee-output-stream
+                    out (l/log-stream :info "blah"))}
+             "echo" "hello\n" "worms")
+    (.toString out)))
+
+(defn invoke [opts & cmd]
+  (l/info (str/join " " (cons "$" cmd)))
+  (let [r (apply p/shell
+                 (merge {:continue true
+                         :in nil :out :string :err :string}
+                        opts)
+                 cmd)
+        bin (first cmd)]
+    r))

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

@@ -90,17 +90,6 @@
               (sp/view #(update % :children seq))
               sp/STAY))
 
-#_
-(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)))

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

@@ -2,7 +2,157 @@
   (:require [babashka.process :as p]
             [net.deertopia.doerg.common :as common]
             [clj-cbor.core :as cbor]
-            [clojure.java.io :as io]))
+            [clojure.java.io :as io]
+            [clojure.string :as str]
+            [clojure.tools.logging :as l]
+            [babashka.fs :as fs])
+  (:import (java.io ByteArrayOutputStream)))
+
+;;; XeLaTeX
+
+(def ^:private scale-divisor 66873.46948423679)
+
+(def ^:private font-size 10)
+
+(def ^:private tightpage-regexp
+  #"Preview: Tightpage (-?\d+) *(-?\d+) *(-?\d+) *(-?\d+)")
+
+(def ^:private preview-start-regexp
+  #"! Preview: Snippet (\d+) started.")
+
+(def ^:private preview-end-regexp
+  #"(?:^Preview: Tightpage.*$)?\n! Preview: Snippet (\d+) ended.\((\d+)\+(\d+)x(\d+)\)")
+
+(defn- invoke [extra-opts & args]
+  (let [namespace (or (::ns extra-opts)
+                      (first args))
+        out-bytes (ByteArrayOutputStream.)
+        out-stream (common/tee-output-stream
+                    out-bytes
+                    (l/log-stream :info (str namespace "/out")))
+        err-stream (l/log-stream :info (str namespace "/err"))
+        opts (merge extra-opts
+                    {:out out-stream :err err-stream :continue true
+                     :shutdown p/destroy-tree
+                     :pre-start-fn (fn [{:keys [cmd]}]
+                                     (l/infof "$ %s"
+                                              (str/join " " cmd)))
+                     :exit-fn (fn [{:keys [cmd exit]}]
+                                (l/infof "%s exited w/ status %d"
+                                         (first cmd) exit))})
+        r (apply p/shell opts args)
+        out (.toString out-bytes)]
+    (-> r
+        (assoc ::out out))))
+
+(defn- parse-tightpage [xelatex-out]
+  (->> (re-find tightpage-regexp xelatex-out)
+       (drop 1)
+       (map parse-long)))
+
+(defn- snippet-dimensions [[tp1 tp2 tp3 tp4] [d1 d2 d3]]
+  (let [depth (/ (- d2 tp2) scale-divisor font-size)]
+    {:depth depth
+     :height (+ depth
+                (/ (+ d1 tp4)
+                   scale-divisor
+                   font-size))
+     :width (/ (+ d3 tp3 (- tp2))
+               scale-divisor
+               font-size)}))
+
+(defn- parse-xelatex-output [out]
+  (let [tightpage-info (parse-tightpage out)
+        m-start (re-matcher preview-start-regexp out)
+        m-end (re-matcher preview-end-regexp out)]
+    (loop [acc []]
+      (if-some [[_ snippet-ix] (re-find m-start)]
+        (let [r (re-find m-end)
+              [_ snippet-ix* _ _ _] r
+              dimensional-info (->> r (drop 2) (map parse-long))
+              errors (-> out
+                         (subs (.end m-start) (.start m-end))
+                         (str/replace-first #"[^!]*" "")
+                         str/trim)]
+          (assert (= snippet-ix snippet-ix*))
+          (recur (conj acc (-> (snippet-dimensions
+                                tightpage-info dimensional-info)
+                               (assoc :errors (if (empty? errors)
+                                                nil
+                                                errors))))))
+        acc))))
+
+(defn- invoke-xelatex [& {:keys [file output-dir]}]
+  (invoke
+   {:dir output-dir}
+   "xelatex" "-no-pdf" "-interaction" "nonstopmode"
+   "-output-directory" output-dir file))
+
+;; dvisvgm --page=1- --optimize --clipjoin --relative --no-fonts -v3 --message='processing page {?pageno}: output written to {?svgpath}' --bbox=preview -o %B-%%9p.svg %f
+
+(defn- invoke-dvisvgm [& {:keys [file output-dir]}]
+  (invoke
+   {:dir output-dir}
+   "dvisvgm" "--page=1-" "--optimize" "--clipjoin"
+   "--relative" "--no-fonts" "-v3"
+   "--message=processing page {?pageno}: output written to {?svgpath}"
+   "--bbox=preview" "-o" "%9p.svg" file))
+
+(defn- snippet-file-names
+  "Return a map of TeX snippets (as strings, including the math
+  delimiters) to file names as would be output by
+  `invoke-dvisvgm`. The returned file names are relative to dvisvgm's
+  output directory."
+  [snippets]
+  (let [svgs (for [i (range)]
+               (format "%09d.svg" i))]
+    (zipmap (reverse snippets) svgs)))
+
+(defn- instantiate-preview-template [snippets]
+  (let [contents (->> (for [s snippets]
+                        (format "\\begin{preview}\n%s\n\\end{preview}" s))
+                      (str/join "\n"))]
+    (-> (io/resource "net/deertopia/doerg/preview-template.tex")
+        slurp
+        (str/replace-first "% {{contents}}" contents))))
+
+(defn render-xelatex [output-dir & snippets]
+  (fs/with-temp-dir [dir {:prefix "doerg-xelatex"}]
+    (let [preview-tex (fs/file dir "preview.tex")
+          preview-xdv (fs/file dir "preview.xdv")
+          distinct-snippets (distinct snippets)]
+      (fs/create-dirs output-dir)
+      (->> (instantiate-preview-template distinct-snippets)
+           (spit preview-tex))
+      (let [dimensions (-> (invoke-xelatex :output-dir dir :file preview-tex)
+                           ::out parse-xelatex-output)
+            _ (invoke-dvisvgm :output-dir output-dir :file preview-xdv)]
+        ;; Adorn each snippet with dimensions and errors parsed from
+        ;; XeLaTeX's output, and the paths to SVG files generated by
+        ;; dvisvgm.
+        (assert (= (count distinct-snippets) (count dimensions)))
+        (->> (map (fn [ix snippet dimensions]
+                    {snippet
+                     (-> dimensions
+                         (assoc
+                          :file (fs/file dir (format "%09d.svg" (inc ix)))))})
+                  (range)
+                  distinct-snippets
+                  dimensions)
+             (into {})))
+      #_
+      (do (when (fs/exists? "/tmp/doerg-tex-test") ; For debugging
+            (fs/delete-tree "/tmp/doerg-tex-test"))
+          (fs/copy-tree dir "/tmp/doerg-tex-test")))))
+
+(comment
+  (render-xelatex "/tmp/doerg-tex-svgs"
+                  "\\(c = \\sqrt{x^2 + y^2}\\)"
+                  "\\(x\\)" "\\(y\\)" "\\(x\\)"
+                  "\\(\\undefinedcommandlol\\)"))
+
+
+;;; Temml
 
 (def ^:dynamic *tex-worker-timeout-duration*
   "Number of milliseconds to wait before killing the external Uniorg