summaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers/Docx.hs
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2014-06-02 20:07:41 -0700
committerJohn MacFarlane <jgm@berkeley.edu>2014-06-02 20:07:41 -0700
commitbf915da6cd0dc97a231100b784450e334c715969 (patch)
treecd9763658b559696cac92f84613c2ecb67543e3e /src/Text/Pandoc/Writers/Docx.hs
parent4552555625fd3904189322c81382166a4f4d1de5 (diff)
Docx writer: Make images work in reference.docx headers/footers.
* All media from reference.docx are copied into result. * Added defaults for common image types to [Content Types]. * Avoided redundant XML parse + write for entries taken over from reference.docx, for better performance.
Diffstat (limited to 'src/Text/Pandoc/Writers/Docx.hs')
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs28
1 files changed, 20 insertions, 8 deletions
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index 098da119b..8aaf3c1b8 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -197,10 +197,21 @@ writeDocx opts doc@(Pandoc meta _) = do
map (\x -> (maybe "" ("/word/" ++) $ extractTarget x,
"application/vnd.openxmlformats-officedocument.wordprocessingml.footer+xml")) footers) ++
map mkImageOverride imgs
+ let imageDefaults = map (\(x,y) -> mknode "Default"
+ [("Extension",x),("ContentType",y)] ())
+ [("jpg","image/jpeg")
+ ,("jpeg","image/jpeg")
+ ,("png","image/png")
+ ,("svg","image/svg+xml")
+ ,("tif","image/tiff")
+ ,("tiff","image/tiff")
+ ,("bmp","image/x-ms-bmp")
+ ,("gif","image/gif")
+ ]
let defaultnodes = [mknode "Default"
[("Extension","xml"),("ContentType","application/xml")] (),
mknode "Default"
- [("Extension","rels"),("ContentType","application/vnd.openxmlformats-package.relationships+xml")] ()]
+ [("Extension","rels"),("ContentType","application/vnd.openxmlformats-package.relationships+xml")] ()] ++ imageDefaults
let contentTypesDoc = mknode "Types" [("xmlns","http://schemas.openxmlformats.org/package/2006/content-types")] $ defaultnodes ++ overrides
let contentTypesEntry = toEntry "[Content_Types].xml" epochtime
$ renderXml contentTypesDoc
@@ -311,12 +322,13 @@ writeDocx opts doc@(Pandoc meta _) = do
headerFooterEntries <- mapM (entryFromArchive refArchive) $
mapMaybe (\e -> fmap ("word/" ++) $ extractTarget e)
(headers ++ footers)
- 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 refArchive) miscRels
+ let miscRelEntries = [ e | e <- zEntries refArchive
+ , "word/_rels/" `isPrefixOf` (eRelativePath e)
+ , ".xml.rels" `isSuffixOf` (eRelativePath e)
+ , eRelativePath e /= "word/_rels/document.xml.rels"
+ , eRelativePath e /= "word/_rels/footnotes.xml.rels" ]
+ let otherMediaEntries = [ e | e <- zEntries refArchive
+ , "word/media/" `isPrefixOf` eRelativePath e ]
-- Create archive
let archive = foldr addEntryToArchive emptyArchive $
@@ -325,7 +337,7 @@ writeDocx opts doc@(Pandoc meta _) = do
docPropsEntry : docPropsAppEntry : themeEntry :
fontTableEntry : settingsEntry : webSettingsEntry :
imageEntries ++ headerFooterEntries ++
- miscRelEntries
+ miscRelEntries ++ otherMediaEntries
return $ fromArchive archive
styleToOpenXml :: Style -> [Element]