-
Notifications
You must be signed in to change notification settings - Fork 12
/
ignored_tag.clj
75 lines (65 loc) · 2.63 KB
/
ignored_tag.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
(ns stencil.postprocess.ignored-tag
"In docx files there might be an Ignored attribute which contains an XML namespace alias list.
The contents of this attribute must be a valid ns alias list on the output document too!"
(:require [clojure.data.xml.pu-map :as pu-map]
[clojure.data.xml.name :as xml-name]
[clojure.string :as s]
[stencil.ooxml :as ooxml]))
(def ^:private ignorable-tag :xmlns.http%3A%2F%2Fschemas.openxmlformats.org%2Fmarkup-compatibility%2F2006/Ignorable)
(def ^:private choice-tag :xmlns.http%3A%2F%2Fschemas.openxmlformats.org%2Fmarkup-compatibility%2F2006/Choice)
;; like clojure.walk/postwalk but keeps metadata and calls fn only on nodes
(defn- postwalk-xml [f xml-tree]
(if (map? xml-tree)
(f (update xml-tree :content (partial mapv (partial postwalk-xml f))))
xml-tree))
(defn- map-str [f s] (s/join " " (keep f (s/split s #"\s+"))))
(defn- gen-alias [uri]
(or (get ooxml/default-aliases uri)
(name (gensym "ign"))))
(defn- update-if-present [m path f] (if (get-in m path) (update-in m path f) m))
(defn- update-choice-requires
"Updates the Requires attribute of a Choice tag with the fn"
[elem f]
(assert (ifn? f))
(if (= (:tag elem) choice-tag)
(update-in elem [:attrs :Requires] f)
elem))
(defn- with-pu [object pu-map]
(assert (map? pu-map))
(assert (:tag object))
(with-meta object
{:clojure.data.xml/nss
(apply pu-map/assoc pu-map/EMPTY (interleave (vals pu-map) (keys pu-map)))}))
;; first call this
(defn map-ignored-attr
"Replaces values in ignorable-tag and requires-tag attributes to
the namespace names they are aliased by."
[xml-tree]
(postwalk-xml
(fn [form]
(let [p->url (get-in (meta form) [:clojure.data.xml/nss :p->u])]
(-> form
(update-if-present [:attrs ignorable-tag] (partial map-str p->url))
(update-choice-requires (partial map-str p->url)))))
xml-tree))
;; last call this
(defn unmap-ignored-attr
"Walks XML tree and replaces xml namespaces with aliases.
Call just before serializing the XML tree."
[xml-tree]
(let [found (volatile! {}) ;; url -> alias mapping
find! (fn [uri]
(or (get @found uri)
(get (vswap! found assoc uri (gen-alias uri)) uri)))]
(with-pu
(postwalk-xml
(fn [form]
(when-let [ns (some-> form :tag xml-name/qname-uri)]
(when (contains? ooxml/default-aliases ns)
(find! ns)))
(-> form
(update-if-present [:attrs ignorable-tag] (partial map-str find!))
(update-choice-requires (partial map-str find!))))
xml-tree)
@found)))
:OK