@@ -52,6 +52,8 @@ import Data.Unique (hashUnique, newUnique)
5252import System.Random (randomRIO)
5353import Text.Printf (printf)
5454import qualified Control.Exception as E
55+import System.FilePath (takeExtension)
56+import Text.Pandoc.MIME (getMimeType)
5557
5658data WriterState = WriterState{
5759 stTextProperties :: [Element]
@@ -59,7 +61,7 @@ data WriterState = WriterState{
5961 , stFootnotes :: [Element]
6062 , stSectionIds :: [String]
6163 , stExternalLinks :: M.Map String String
62− , stImages :: M.Map FilePath (String, String, Element, B.ByteString)
64+ , stImages :: M.Map FilePath (String, String, Maybe String, Element, B.ByteString)
6365 , stListLevel :: Int
6466 , stListNumId :: Int
6567 , stNumStyles :: M.Map ListMarker Int
@@ -112,40 +114,41 @@ writeDocx opts doc@(Pandoc (Meta tit auths date) _) = do
112114 defaultWriterState
113115 epochtime <- floor `fmap` getPOSIXTime
114116 let imgs = M.elems $ stImages st
115− let toImgRel (ident,path,_,_) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"),("Id",ident),("Target",path)] ()
117+ let toImgRel (ident,path,_,_,_) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"),("Id",ident),("Target",path)] ()
118+
119+ -- word/_rels/document.xml.rels
116120 let newrels = map toImgRel imgs
117121 let relpath = "word/_rels/document.xml.rels"
118− let reldoc = case findEntryByPath relpath refArchive >>=
119− parseXMLDoc . UTF8.toStringLazy . fromEntry of
120− Just d -> d
121− Nothing -> error $ relpath ++ "missing in reference docx"
122+ reldoc <- parseXml refArchive relpath
122123 let reldoc' = reldoc{ elContent = elContent reldoc ++ map Elem newrels }
124+
123125 -- create entries for images
124− let toImageEntry (_,path,_,img) = toEntry ("word/" ++ path) epochtime $ toLazy img
126+ let toImageEntry (_,path,_,_,img) = toEntry ("word/" ++ path) epochtime $ toLazy img
125127 let imageEntries = map toImageEntry imgs
128+
126129 -- NOW get list of external links and images from this, and do what's needed
127130 let toLinkRel (src,ident) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink"),("Id",ident),("Target",src),("TargetMode","External") ] ()
128131 let newrels' = map toLinkRel $ M.toList $ stExternalLinks st
129132 let reldoc'' = reldoc' { elContent = elContent reldoc' ++ map Elem newrels' }
130133 let relEntry = toEntry relpath epochtime $ UTF8.fromStringLazy $ showTopElement' reldoc''
131134 let contentEntry = toEntry "word/document.xml" epochtime $ UTF8.fromStringLazy $ showTopElement' contents
135+
132136 -- footnotes
133137 let footnotesEntry = toEntry "word/footnotes.xml" epochtime $ UTF8.fromStringLazy $
134138 showTopElement' footnotes
139+
135140 -- footnote rels
136141 let footnoteRelEntry = toEntry "word/_rels/footnotes.xml.rels" epochtime $ UTF8.fromStringLazy $
137142 showTopElement' $ mknode "Relationships" [("xmlns","http://schemas.openxmlformats.org/package/2006/relationships")]
138143 $ newrels'
144+
139145 -- styles
140146 let newstyles = styleToOpenXml $ writerHighlightStyle opts
141147 let stylepath = "word/styles.xml"
142− let styledoc = case findEntryByPath stylepath refArchive >>=
143− parseXMLDoc . UTF8.toStringLazy . fromEntry of
144− Just d -> d
145− Nothing -> error $ "Unable to parse " ++ stylepath ++
146− " from reference.docx"
148+ styledoc <- parseXml refArchive stylepath
147149 let styledoc' = styledoc{ elContent = elContent styledoc ++ map Elem newstyles }
148150 let styleEntry = toEntry stylepath epochtime $ UTF8.fromStringLazy $ showTopElement' styledoc'
151+
149152 -- construct word/numbering.xml
150153 let numpath = "word/numbering.xml"
151154 numEntry <- (toEntry numpath epochtime . UTF8.fromStringLazy . showTopElement')
@@ -167,11 +170,14 @@ writeDocx opts doc@(Pandoc (Meta tit auths date) _) = do
167170 rels <- case findEntryByPath relsPath refArchive of
168171 Just e -> return $ UTF8.toStringLazy $ fromEntry e
169172 Nothing -> err 57 "could not find .rels/_rels in reference docx"
173+
170174 -- fix .rels/_rels, which can get screwed up when reference.docx is edited by Word
171175 let rels' = substitute "http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties"
172176 "http://schemas.openxmlformats.org/officedocument/2006/relationships/metadata/core-properties"
173177 rels
174178 let relsEntry = toEntry relsPath epochtime $ UTF8.fromStringLazy rels'
179+
180+ -- Create archive
175181 let archive = foldr addEntryToArchive refArchive $
176182 relsEntry : contentEntry : relEntry : footnoteRelEntry : numEntry : styleEntry : footnotesEntry : docPropsEntry : imageEntries
177183 return $ fromArchive archive
@@ -623,7 +629,7 @@ inlineToOpenXML opts (Image alt (src, tit)) = do
623629 -- first, check to see if we've already done this image
624630 imgs <- gets stImages
625631 case M.lookup src imgs of
626− Just (_,_,elt,_) -> return [elt]
632+ Just (_,_,_,elt,_) -> return [elt]
627633 Nothing -> do
628634 let sourceDir = writerSourceDirectory opts
629635 res <- liftIO $ E.try $ fetchItem sourceDir src
@@ -671,17 +677,31 @@ inlineToOpenXML opts (Image alt (src, tit)) = do
671677 , mknode "wp:effectExtent" [("b","0"),("l","0"),("r","0"),("t","0")] ()
672678 , mknode "wp:docPr" [("descr",tit),("id","1"),("name","Picture")] ()
673679 , graphic ]
674− modify $ \st -> st{ stImages = M.insert src (ident, imgPath ident img, imgElt, img) $ stImages st }
675− return [imgElt]
676−
677−imgPath :: String -> B.ByteString -> String
678−imgPath ident img = "media/" ++ ident ++
679− case imageType img of
680− Just Png -> ".png"
681− Just Jpeg -> ".jpeg"
682− Just Gif -> ".gif"
683− Just Pdf -> ".pdf"
684− Nothing -> ""
680+ let imgext = case imageType img of
681+ Just Png -> ".png"
682+ Just Jpeg -> ".jpeg"
683+ Just Gif -> ".gif"
684+ Just Pdf -> ".pdf"
685+ Nothing -> takeExtension src
686+ if null imgext
687+ then -- without an extension there is no rule for content type
688+ inlinesToOpenXML opts alt -- return alt to avoid corrupted docx
689+ else do
690+ let imgpath = "media/" ++ ident ++ imgext
691+ let mbMimeType = getMimeType imgpath
692+ -- TODO also insert mime type; later can use this
693+ -- to construct [Content_Types].xml
694+ modify $ \st -> st{ stImages =
695+ M.insert src (ident, imgpath, mbMimeType, imgElt, img)
696+ $ stImages st }
697+ return [imgElt]
685698
686699br :: Element
687700br = mknode "w:r" [] [mknode "w:cr" [] () ]
701+
702+parseXml :: Archive -> String -> IO Element
703+parseXml refArchive relpath =
704+ case (findEntryByPath relpath refArchive >>= parseXMLDoc . UTF8.toStringLazy . fromEntry) of
705+ Just d -> return d
706+ Nothing -> fail $ relpath ++ " missing in reference docx"
707+