@@ -59,6 +59,7 @@ import Text.Printf (printf)
5959import qualified Control.Exception as E
6060import Text.Pandoc.MIME (getMimeType, extensionFromMimeType)
6161import Control.Applicative ((<|>))
62+import Data.Maybe (mapMaybe)
6263
6364data ListMarker = NoMarker
6465 | BulletMarker
@@ -123,6 +124,40 @@ writeDocx opts doc@(Pandoc meta _) = do
123124 epochtime <- floor `fmap` getPOSIXTime
124125 let imgs = M.elems $ stImages st
125126
127+ -- create entries for images in word/media/...
128+ let toImageEntry (_,path,_,_,img) = toEntry ("word/" ++ path) epochtime $ toLazy img
129+ let imageEntries = map toImageEntry imgs
130+
131+ -- adjust contents to add sectPr from reference.docx
132+ parsedDoc <- parseXml refArchive distArchive "word/document.xml"
133+ let wname f qn = qPrefix qn == Just "w" && f (qName qn)
134+ let mbsectpr = filterElementName (wname (=="sectPr")) parsedDoc
135+
136+ let sectpr = maybe (mknode "w:sectPr" [] $ ()) id mbsectpr
137+
138+ let stdAttributes =
139+ [("xmlns:w","http://schemas.openxmlformats.org/wordprocessingml/2006/main")
140+ ,("xmlns:m","http://schemas.openxmlformats.org/officeDocument/2006/math")
141+ ,("xmlns:r","http://schemas.openxmlformats.org/officeDocument/2006/relationships")
142+ ,("xmlns:o","urn:schemas-microsoft-com:office:office")
143+ ,("xmlns:v","urn:schemas-microsoft-com:vml")
144+ ,("xmlns:w10","urn:schemas-microsoft-com:office:word")
145+ ,("xmlns:a","http://schemas.openxmlformats.org/drawingml/2006/main")
146+ ,("xmlns:pic","http://schemas.openxmlformats.org/drawingml/2006/picture")
147+ ,("xmlns:wp","http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing")]
148+
149+ let contents' = contents ++ [sectpr]
150+ let docContents = mknode "w:document" stdAttributes
151+ $ mknode "w:body" [] $ contents'
152+
153+ parsedRels <- parseXml refArchive distArchive "word/_rels/document.xml.rels"
154+ let isHeaderNode e = findAttr (QName "Type" Nothing Nothing) e == Just "http://schemas.openxmlformats.org/officeDocument/2006/relationships/header"
155+ let isFooterNode e = findAttr (QName "Type" Nothing Nothing) e == Just "http://schemas.openxmlformats.org/officeDocument/2006/relationships/footer"
156+ let headers = filterElements isHeaderNode parsedRels
157+ let footers = filterElements isFooterNode parsedRels
158+
159+ let extractTarget e = findAttr (QName "Target" Nothing Nothing) e
160+
126161 -- we create [Content_Types].xml and word/_rels/document.xml.rels
127162 -- from scratch rather than reading from reference.docx,
128163 -- because Word sometimes changes these files when a reference.docx is modified,
@@ -135,7 +170,7 @@ writeDocx opts doc@(Pandoc meta _) = do
135170 let mkImageOverride (_, imgpath, mbMimeType, _, _) =
136171 mkOverrideNode ("/word/" ++ imgpath,
137172 fromMaybe "application/octet-stream" mbMimeType)
138− let overrides = map mkOverrideNode
173+ let overrides = map mkOverrideNode (
139174 [("/word/webSettings.xml",
140175 "application/vnd.openxmlformats-officedocument.wordprocessingml.webSettings+xml")
141176 ,("/word/numbering.xml",
@@ -155,11 +190,13 @@ writeDocx opts doc@(Pandoc meta _) = do
155190 ,("/word/document.xml",
156191 "application/vnd.openxmlformats-officedocument.wordprocessingml.document.main+xml")
157192 ,("/word/footnotes.xml",
158− "application/vnd.openxmlformats-officedocument.wordprocessingml.footnotes+xml"),
159− ("/word/header1.xml",
160− "application/vnd.openxmlformats-officedocument.wordprocessingml.header+xml"),
161− ("/word/footer1.xml",
162− "application/vnd.openxmlformats-officedocument.wordprocessingml.footer+xml") ] ++ map mkImageOverride imgs
193+ "application/vnd.openxmlformats-officedocument.wordprocessingml.footnotes+xml")
194+ ] ++
195+ map (\x -> (maybe "" ("/word/" ++) $ extractTarget x,
196+ "application/vnd.openxmlformats-officedocument.wordprocessingml.header+xml")) headers ++
197+ map (\x -> (maybe "" ("/word/" ++) $ extractTarget x,
198+ "application/vnd.openxmlformats-officedocument.wordprocessingml.footer+xml")) footers) ++
199+ map mkImageOverride imgs
163200 let defaultnodes = [mknode "Default"
164201 [("Extension","xml"),("ContentType","application/xml")] (),
165202 mknode "Default"
@@ -195,13 +232,8 @@ writeDocx opts doc@(Pandoc meta _) = do
195232 ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/footnotes",
196233 "rId7",
197234 "footnotes.xml")
198− ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/header",
199− "rId8",
200− "header1.xml")
201− ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/footer",
202− "rId9",
203− "footer1.xml")
204− ]
235+ ] ++
236+ headers ++ footers
205237 let toImgRel (ident,path,_,_,_) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"),("Id",ident),("Target",path)] ()
206238 let imgrels = map toImgRel imgs
207239 let toLinkRel (src,ident) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink"),("Id",ident),("Target",src),("TargetMode","External") ] ()
@@ -210,38 +242,6 @@ writeDocx opts doc@(Pandoc meta _) = do
210242 let relEntry = toEntry "word/_rels/document.xml.rels" epochtime
211243 $ renderXml reldoc
212244
213− -- create entries for images in word/media/...
214− let toImageEntry (_,path,_,_,img) = toEntry ("word/" ++ path) epochtime $ toLazy img
215− let imageEntries = map toImageEntry imgs
216−
217− -- adjust contents to add sectPr from reference.docx
218− let docpath = "word/document.xml"
219− parsedDoc <- parseXml refArchive distArchive docpath
220− let mbsectpr = filterElementName (\qn -> qPrefix qn == Just "w" &&
221− qName qn == "sectPr") parsedDoc
222− let sectPrProps = case mbsectpr of
223− Nothing -> []
224− Just e -> filterElementsName (\qn ->
225− qPrefix qn == Just "w" &&
226− qName qn `notElem` ["headerReference","footerReference","sectPr"]) e
227− let headerPr = mknode "w:headerReference" [("w:type","default"),("r:id","rId8")] $ ()
228− let footerPr = mknode "w:footerReference" [("w:type","default"),("r:id","rId9")] $ ()
229− let sectpr = mknode "w:sectPr" [] $ [headerPr, footerPr] ++ sectPrProps
230−
231− let stdAttributes =
232− [("xmlns:w","http://schemas.openxmlformats.org/wordprocessingml/2006/main")
233− ,("xmlns:m","http://schemas.openxmlformats.org/officeDocument/2006/math")
234− ,("xmlns:r","http://schemas.openxmlformats.org/officeDocument/2006/relationships")
235− ,("xmlns:o","urn:schemas-microsoft-com:office:office")
236− ,("xmlns:v","urn:schemas-microsoft-com:vml")
237− ,("xmlns:w10","urn:schemas-microsoft-com:office:word")
238− ,("xmlns:a","http://schemas.openxmlformats.org/drawingml/2006/main")
239− ,("xmlns:pic","http://schemas.openxmlformats.org/drawingml/2006/picture")
240− ,("xmlns:wp","http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing")]
241−
242− let contents' = contents ++ [sectpr]
243− let docContents = mknode "w:document" stdAttributes
244− $ mknode "w:body" [] $ contents'
245245
246246 -- word/document.xml
247247 let contentEntry = toEntry "word/document.xml" epochtime
@@ -304,13 +304,13 @@ writeDocx opts doc@(Pandoc meta _) = do
304304 docPropsAppEntry <- entryFromArchive refArchive "docProps/app.xml"
305305 themeEntry <- entryFromArchive refArchive "word/theme/theme1.xml"
306306 fontTableEntry <- entryFromArchive refArchive "word/fontTable.xml"
307− -- we take settings.xml from dist archive because the ref archive
308− -- sometimes references special footnotes and endnotes that may
309− -- not be defined in footnotes.xml or endnotes.xml.
307+ -- we use dist archive for settings.xml, because Word sometimes
308+ -- adds references to footnotes or endnotes we don't have...
310309 settingsEntry <- entryFromArchive distArchive "word/settings.xml"
311− webSettingsEntry <- entryFromArchive distArchive "word/webSettings.xml"
312− headerEntry <- entryFromArchive refArchive "word/header1.xml"
313− footerEntry <- entryFromArchive refArchive "word/footer1.xml"
310+ webSettingsEntry <- entryFromArchive refArchive "word/webSettings.xml"
311+ headerFooterEntries <- mapM (entryFromArchive refArchive) $
312+ mapMaybe (\e -> fmap ("word/" ++) $ extractTarget e)
313+ (headers ++ footers)
314314 let miscRels = [ f | f <- filesInArchive refArchive
315315 , "word/_rels/" `isPrefixOf` f
316316 , ".xml.rels" `isSuffixOf` f
@@ -324,7 +324,8 @@ writeDocx opts doc@(Pandoc meta _) = do
324324 footnoteRelEntry : numEntry : styleEntry : footnotesEntry :
325325 docPropsEntry : docPropsAppEntry : themeEntry :
326326 fontTableEntry : settingsEntry : webSettingsEntry :
327− headerEntry : footerEntry : imageEntries ++ miscRelEntries
327+ imageEntries ++ headerFooterEntries ++
328+ miscRelEntries
328329 return $ fromArchive archive
329330
330331styleToOpenXml :: Style -> [Element]