From 6848f642e82322c0894c62d3215e98325ab7fd8c Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sun, 1 Jun 2014 21:15:03 -0700 Subject: Docx writer: Header and footer are now carried over from reference.docx. --- data/reference.docx | Bin 9797 -> 9360 bytes src/Text/Pandoc/Writers/Docx.hs | 54 ++++++++++++++++++++++++++++------------ 2 files changed, 38 insertions(+), 16 deletions(-) diff --git a/data/reference.docx b/data/reference.docx index a9c268b9f..789237dd8 100644 Binary files a/data/reference.docx and b/data/reference.docx differ diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 026cfcb41..584662be8 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -155,8 +155,11 @@ writeDocx opts doc@(Pandoc meta _) = do ,("/word/document.xml", "application/vnd.openxmlformats-officedocument.wordprocessingml.document.main+xml") ,("/word/footnotes.xml", - "application/vnd.openxmlformats-officedocument.wordprocessingml.footnotes+xml") - ] ++ map mkImageOverride imgs + "application/vnd.openxmlformats-officedocument.wordprocessingml.footnotes+xml"), + ("/word/header1.xml", + "application/vnd.openxmlformats-officedocument.wordprocessingml.header+xml"), + ("/word/footer1.xml", + "application/vnd.openxmlformats-officedocument.wordprocessingml.footer+xml") ] ++ map mkImageOverride imgs let defaultnodes = [mknode "Default" [("Extension","xml"),("ContentType","application/xml")] (), mknode "Default" @@ -191,7 +194,14 @@ writeDocx opts doc@(Pandoc meta _) = do "theme/theme1.xml") ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/footnotes", "rId7", - "footnotes.xml")] + "footnotes.xml") + ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/header", + "rId8", + "header1.xml") + ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/footer", + "rId9", + "footer1.xml") + ] let toImgRel (ident,path,_,_,_) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"),("Id",ident),("Target",path)] () let imgrels = map toImgRel imgs let toLinkRel (src,ident) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink"),("Id",ident),("Target",src),("TargetMode","External") ] () @@ -207,9 +217,16 @@ writeDocx opts doc@(Pandoc meta _) = do -- adjust contents to add sectPr from reference.docx let docpath = "word/document.xml" parsedDoc <- parseXml refArchive distArchive docpath - let sectprs = filterElementsName (\qn -> qPrefix qn == Just "w" && - qName qn == "sectPr") - parsedDoc + let mbsectpr = filterElementName (\qn -> qPrefix qn == Just "w" && + qName qn == "sectPr") parsedDoc + let sectPrProps = case mbsectpr of + Nothing -> [] + Just e -> filterElementsName (\qn -> + qPrefix qn == Just "w" && + qName qn `notElem` ["headerReference","footerReference","sectPr"]) e + let headerPr = mknode "w:headerReference" [("w:type","default"),("r:id","rId8")] $ () + let footerPr = mknode "w:footerReference" [("w:type","default"),("r:id","rId9")] $ () + let sectpr = mknode "w:sectPr" [] $ [headerPr, footerPr] ++ sectPrProps let stdAttributes = [("xmlns:w","http://schemas.openxmlformats.org/wordprocessingml/2006/main") @@ -222,7 +239,7 @@ writeDocx opts doc@(Pandoc meta _) = do ,("xmlns:pic","http://schemas.openxmlformats.org/drawingml/2006/picture") ,("xmlns:wp","http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing")] - let contents' = contents ++ sectprs + let contents' = contents ++ [sectpr] let docContents = mknode "w:document" stdAttributes $ mknode "w:body" [] $ contents' @@ -281,20 +298,25 @@ writeDocx opts doc@(Pandoc meta _) = do ] let relsEntry = toEntry relsPath epochtime $ renderXml rels - let entryFromArchive path = + let entryFromArchive arch path = (toEntry path epochtime . renderXml) `fmap` - parseXml refArchive distArchive path - docPropsAppEntry <- entryFromArchive "docProps/app.xml" - themeEntry <- entryFromArchive "word/theme/theme1.xml" - fontTableEntry <- entryFromArchive "word/fontTable.xml" - settingsEntry <- entryFromArchive "word/settings.xml" - webSettingsEntry <- entryFromArchive "word/webSettings.xml" + parseXml arch distArchive path + docPropsAppEntry <- entryFromArchive refArchive "docProps/app.xml" + themeEntry <- entryFromArchive refArchive "word/theme/theme1.xml" + fontTableEntry <- entryFromArchive refArchive "word/fontTable.xml" + -- we take settings.xml from dist archive because the ref archive + -- sometimes references special footnotes and endnotes that may + -- not be defined in footnotes.xml or endnotes.xml. + settingsEntry <- entryFromArchive distArchive "word/settings.xml" + webSettingsEntry <- entryFromArchive distArchive "word/webSettings.xml" + headerEntry <- entryFromArchive refArchive "word/header1.xml" + footerEntry <- entryFromArchive refArchive "word/footer1.xml" let miscRels = [ f | f <- filesInArchive refArchive , "word/_rels/" `isPrefixOf` f , ".xml.rels" `isSuffixOf` f , f /= "word/_rels/document.xml.rels" , f /= "word/_rels/footnotes.xml.rels" ] - miscRelEntries <- mapM entryFromArchive miscRels + miscRelEntries <- mapM (entryFromArchive refArchive) miscRels -- Create archive let archive = foldr addEntryToArchive emptyArchive $ @@ -302,7 +324,7 @@ writeDocx opts doc@(Pandoc meta _) = do footnoteRelEntry : numEntry : styleEntry : footnotesEntry : docPropsEntry : docPropsAppEntry : themeEntry : fontTableEntry : settingsEntry : webSettingsEntry : - imageEntries ++ miscRelEntries + headerEntry : footerEntry : imageEntries ++ miscRelEntries return $ fromArchive archive styleToOpenXml :: Style -> [Element] -- cgit v1.2.3