Fix loop numbering

src/stencil/cleanup.clj

@@ -8,7 +8,8 @@
  valid XML String -> tokens -> Annotated Control AST -> Normalized Control AST -> Evaled AST -> Hiccup or valid XML String
  "
  (:require [stencil.util :refer [mod-stack-top-conj mod-stack-top-last parsing-exception stacks-difference-key]]
- [stencil.types :refer [open-tag close-tag]]))
+ [stencil.types :refer [open-tag close-tag]]
+ [stencil.ooxml :as ooxml]))
 
 (set! *warn-on-reflection* true)
 
@@ -209,12 +210,42 @@
  :when (= :cmd/include (:cmd item))]
  (:name item))))
 
+;; add ::depth to ooxml/numId elements
+(defn- ast-numbering-depths [ast]
+ (let [numid->paths (volatile! {})
+ numid->depth (memoize (fn [id]
+ (->> (get @numid->paths id)
+ (map reverse)
+ (apply map =)
+ (take-while true?)
+ (count))))]
+ (letfn [(visit-all [path xs] (doseq [x xs] (visit path x)))
+ (visit [path x]
+ (if (= ooxml/attr-numId (:open+close x))
+ (vswap! numid->paths update (-> x :attrs ooxml/val)
+ (fnil conj #{}) path)
+ (when-let [blocks (::blocks x)]
+ (let [path (if (= :for (:cmd x))
+ (cons (gensym) path) path)]
+ (doseq [block blocks]
+ (visit-all path (::children block)))))))]
+ (visit-all () ast))
+ (mapv
+ (partial nested-tokens-fmap-postwalk
+ identity identity
+ (fn [e]
+ (if (= ooxml/attr-numId (:open+close e))
+ (assoc-in e [:attrs ::depth] (numid->depth (-> e :attrs ooxml/val)))
+ e)))
+ ast)))
+
+
 (defn process [raw-token-seq]
  (let [ast (tokens->ast raw-token-seq)
+ ast (ast-numbering-depths ast)
  executable (mapv control-ast-normalize (annotate-environments ast))]
  {:variables (find-variables ast)
  :fragments (find-fragments ast)
  :dynamic? (boolean (some :cmd executable))
  :executable executable}))
-
-:OK
+:OK

src/stencil/eval.clj

@@ -5,37 +5,38 @@
  [stencil.types :refer [control?]]
  [stencil.tokenizer :as tokenizer]
  [stencil.util :refer [eval-exception]]
- [stencil.tree-postprocess :as tree-postprocess]))
+ [stencil.tree-postprocess :as tree-postprocess]
+ [stencil.ooxml :as ooxml]))
 
 (set! *warn-on-reflection* true)
 
-(defmulti eval-step (fn [function data item] (:cmd item)))
+(defmulti eval-step (fn [function data trace item] (or (:cmd item) (:open+close item))))
 
-(defmethod eval-step :default [_ _ item] [item])
+(defmethod eval-step :default [_ _ _ item] [item])
 
-(defn normal-control-ast->evaled-seq [data function items]
+(defn normal-control-ast->evaled-seq [data function trace items]
  (assert (map? data))
  (assert (ifn? function))
  (assert (or (nil? items) (sequential? items)))
- (eduction (mapcat (partial eval-step function data)) items))
+ (eduction (mapcat (partial eval-step function data trace)) items))
 
 (defn- eval-rpn* [data function expr raw-expr]
  (try (eval-rpn data function expr)
  (catch Exception e
  (throw (eval-exception (str "Error evaluating expression: " raw-expr) e)))))
 
-(defmethod eval-step :if [function data item]
+(defmethod eval-step :if [function data trace item]
  (let [condition (eval-rpn* data function (:condition item) (:raw item))]
  (log/trace "Condition {} evaluated to {}" (:condition item) condition)
  (->> (if condition (:branch/then item) (:branch/else item))
- (normal-control-ast->evaled-seq data function))))
+ (normal-control-ast->evaled-seq data function trace))))
 
-(defmethod eval-step :cmd/echo [function data item]
+(defmethod eval-step :cmd/echo [function data _ item]
  (let [value (eval-rpn* data function (:expression item) (:raw item))]
  (log/trace "Echoing {} as {}" (:expression item) value)
  [{:text (if (control? value) value (str value))}]))
 
-(defmethod eval-step :for [function data item]
+(defmethod eval-step :for [function data trace item]
  (let [items (eval-rpn* data function (:expression item) (:raw item))]
  (log/trace "Loop on {} will repeat {} times" (:expression item) (count items))
  (if (not-empty items)
@@ -45,13 +46,17 @@
  datas (if (or (instance? java.util.Map items) (map? items))
  (map datamapper (keys items) (vals items))
  (map-indexed datamapper items))
- bodies (cons (:branch/body-run-once item) (repeat (:branch/body-run-next item)))]
- (mapcat (fn [data body] (normal-control-ast->evaled-seq data function body)) datas bodies))
+ bodies (cons (:branch/body-run-once item) (repeat (:branch/body-run-next item)))
+ traces (for [i (range)] (cons i trace))]
+ (mapcat (fn [data body trace] (normal-control-ast->evaled-seq data function trace body)) datas bodies traces))
  (:branch/body-run-none item))))
 
+(defmethod eval-step ooxml/attr-numId [_ _ trace item]
+ [(assoc-in item [:attrs ::trace] trace)])
+
 (defn eval-executable [part data functions]
  (->> (:executable part)
  (#(doto % assert))
- (normal-control-ast->evaled-seq data functions)
+ (normal-control-ast->evaled-seq data functions ())
  (tokenizer/tokens-seq->document)
  (tree-postprocess/postprocess)))

src/stencil/model.clj

@@ -6,6 +6,7 @@
  (:require [clojure.data.xml :as xml]
  [clojure.java.io :as io :refer [file]]
  [stencil.eval :as eval]
+ [stencil.ooxml :as ooxml]
  [stencil.merger :as merger]
  [stencil.model.numbering :as numbering]
  [stencil.types :refer [->FragmentInvoke ->ReplaceImage]]
@@ -55,7 +56,6 @@
  {:source-file cts
  ::path (.getName cts)})
 
-
 (defn ->exec [xml-streamable]
  (with-open [stream (io/input-stream xml-streamable)]
  (-> (merger/parse-to-tokens-seq stream)
@@ -123,7 +123,7 @@
  (assert (:main template-model) "Should be a result of load-template-model call!")
  (assert (some? fragments))
  (binding [*current-styles* (atom (:parsed (:style (:main template-model))))
- numbering/*numbering* (::numbering (:main template-model))
+ numbering/*numbering* (atom (::numbering (:main template-model)))
  *inserted-fragments* (atom #{})
  *extra-files* (atom #{})
  *all-fragments* (into {} fragments)]
@@ -154,6 +154,7 @@
  :finally (assoc :result result))))]
  (-> template-model
  (update :main evaluate)
+ (assoc-in [:main ::numbering] @numbering/*numbering*)
  (update-in [:main :headers+footers] (partial mapv evaluate))
 
  (cond-> (-> template-model :main :style)
@@ -220,7 +221,7 @@
  elem)))
 
 
-(defmethod eval/eval-step :cmd/include [function local-data-map {frag-name :name}]
+(defmethod eval/eval-step :cmd/include [function local-data-map _ {frag-name :name}]
  (assert (map? local-data-map))
  (assert (string? frag-name))
  (expect-fragment-context!

src/stencil/model/numbering.clj

@@ -2,14 +2,14 @@
  (:require [clojure.data.xml :as xml]
  [clojure.java.io :as io]
  [stencil.ooxml :as ooxml]
- [stencil.util :refer [unlazy-tree ->int assoc-if-val]]
+ [stencil.util :refer [unlazy-tree ->int find-first assoc-if-val]]
  [stencil.model.common :refer [unix-path]]))
 
 
 (def ^:private rel-type-numbering
  "http:https://schemas.openxmlformats.org/officeDocument/2006/relationships/numbering")
 
-
+;; swap an atom here!
 (def ^:dynamic *numbering* nil)
 
 
@@ -84,6 +84,41 @@
 (defn style-def-for [id lvl]
  (assert (string? id))
  (assert (integer? lvl))
- (some-> (:parsed *numbering*)
+ (some-> (:parsed @*numbering*)
  (get-id-style-xml id lvl)
  (xml-lvl-parse)))
+
+
+(defn- tag-lvl-start-override [lvl start]
+ {:tag ooxml/lvl-override
+ :attrs {ooxml/attr-ilvl lvl}
+ :content [{:tag ooxml/start-override :attrs {ooxml/val start}}]})
+
+
+(defn copy-numbering!
+ "Creates a copy of the numbering definition an returns the new id for it."
+ [old-id]
+ (let [old-elem (find-first (fn [e] (-> e :attrs ooxml/attr-numId (= old-id)))
+ (:content (:parsed @*numbering*)))
+ abstract-num-id (some (fn [e]
+ (when (= ooxml/xml-abstract-num-id (:tag e))
+ (-> e :attrs ooxml/val)))
+ (:content old-elem))
+ max-num-id (apply max (keep (comp ->int ooxml/attr-numId :attrs)
+ (:content (:parsed @*numbering*))))
+ new-id (str (inc max-num-id))
+ new-elem (assoc-in old-elem [:attrs ooxml/attr-numId] new-id)
+ new-elem (update new-elem :content concat
+ (for [abstract (:content (:parsed @*numbering*))
+ :when (= abstract-num-id (-> abstract :attrs ooxml/xml-abstract-num-id))
+ lvl (:content abstract)
+ :when (= (:tag lvl) ooxml/tag-lvl)
+ start (:content lvl)
+ :when (= "start" (name (:tag start)))]
+ (tag-lvl-start-override (-> lvl :attrs ooxml/attr-ilvl) (-> start :attrs ooxml/val))))]
+ (assert old-elem)
+ (swap! *numbering* update :parsed update :content concat [new-elem])
+ (swap! *numbering* dissoc :source-file)
+ (swap! *numbering* (fn [numbering]
+ (assoc numbering :result {:writer (stencil.model.common/->xml-writer (:parsed numbering))})))
+ new-id))

src/stencil/ooxml.clj

@@ -68,6 +68,9 @@
 
 (def attr-ilvl :xmlns.http%3A%2F%2Fschemas.openxmlformats.org%2Fwordprocessingml%2F2006%2Fmain/ilvl)
 
+(def lvl-override :xmlns.http%3A%2F%2Fschemas.openxmlformats.org%2Fwordprocessingml%2F2006%2Fmain/lvlOverride)
+(def start-override :xmlns.http%3A%2F%2Fschemas.openxmlformats.org%2Fwordprocessingml%2F2006%2Fmain/startOverride)
+
 (def default-aliases
  {;default namespace aliases from a LibreOffice 6.4 OOXML Text document
  "http:https://schemas.openxmlformats.org/markup-compatibility/2006" "mc"

src/stencil/postprocess/numberings.clj

@@ -0,0 +1,30 @@
+(ns stencil.postprocess.numberings
+ (:require [stencil.util :refer :all]
+ [stencil.ooxml :as ooxml]
+ [stencil.model.numbering :as numbering]
+ [stencil.log :as log]
+ [clojure.zip :as zip]))
+
+(defn- get-new-id [numbering-id trace]
+ (log/debug "Getting new list for old {} trace {}" numbering-id trace)
+ (if (empty? trace)
+ numbering-id
+ (numbering/copy-numbering! numbering-id)))
+
+(defn- lookup [get-new-id element]
+ (get-new-id (ooxml/val (:attrs element))
+ (take-last (:stencil.cleanup/depth (:attrs element))
+ (:stencil.eval/trace (:attrs element)))))
+
+(defn- fix-one [numbering lookup]
+ (-> numbering
+ (update :attrs dissoc :stencil.cleanup/depth :stencil.eval/trace)
+ (update :attrs assoc ooxml/val (lookup numbering))))
+
+(defn fix-numberings [xml-tree]
+ (let [lookup (partial lookup (memoize get-new-id))]
+ (dfs-walk-xml-node
+ xml-tree
+ (fn [e] (= ooxml/attr-numId (:tag e)))
+ (fn [e] (zip/edit e fix-one lookup)))))
+

src/stencil/tree_postprocess.clj

@@ -6,6 +6,7 @@
  [stencil.postprocess.images :refer :all]
  [stencil.postprocess.list-ref :refer :all]
  [stencil.postprocess.fragments :refer :all]
+ [stencil.postprocess.numberings :refer [fix-numberings]]
  [stencil.postprocess.html :refer :all]))
 
 ;; calls postprocess
@@ -26,6 +27,8 @@
 
  #'fix-list-dirty-refs
 
+ #'fix-numberings
+
  #'replace-images
 
  ;; call this first. includes fragments and evaluates them too.

test/stencil/model/numbering_test.clj

@@ -10,11 +10,12 @@
  {:tag tag, :attrs attrs, :content (mapv hiccup children)}))
 
 (deftest test-style-for-def-empty
- (binding [*numbering* {:parsed (prepare-numbering-xml {:tag :numbering :content []})}]
+ (binding [*numbering* (atom {:parsed (prepare-numbering-xml {:tag :numbering :content []})})]
  (is (= nil (style-def-for "id-1" 2)))))
 
 (deftest test-style-for-def-with-abstract
  (binding [*numbering*
+ (atom
  {:parsed
  (prepare-numbering-xml
  (hiccup
@@ -27,13 +28,14 @@
  [:lvlText {ooxml/val ""}]
  [:lvlJc {ooxml/val "start"}]]]
  [ooxml/tag-num {ooxml/attr-numId "id-1"}
- [ooxml/xml-abstract-num-id {ooxml/val "a1"}]]]))}]
+ [ooxml/xml-abstract-num-id {ooxml/val "a1"}]]]))})]
  (is (= {:lvl-text "", :num-fmt "none", :start 1}
  (style-def-for "id-1" 2)))))
 
 
 (deftest test-style-for-def
  (binding [*numbering*
+ (atom
  {:parsed
  (prepare-numbering-xml
  (hiccup
@@ -44,6 +46,6 @@
  [:numFmt {ooxml/val "none"}]
  [:suff {ooxml/val "nothing"}]
  [:lvlText {ooxml/val ""}]
- [:lvlJc {ooxml/val "start"}]]]]))}]
+ [:lvlJc {ooxml/val "start"}]]]]))})]
  (is (= {:lvl-text "", :num-fmt "none", :start 1}
  (style-def-for "id-1" 2)))))