@@ -105,7 +105,7 @@ writeDocx opts doc@(Pandoc (Meta tit auths date) _) = do
105 Nothing -> (B.fromChunks . (:[])) `fmap`
105 Nothing -> (B.fromChunks . (:[])) `fmap`
106 readDataFile datadir "reference.docx"
106 readDataFile datadir "reference.docx"
108− (newContents, st) <- runStateT (writeOpenXML opts{writerWrapText = False} doc)
108+ ((contents, footnotes), st) <- runStateT (writeOpenXML opts{writerWrapText = False} doc)
109 defaultWriterState
109 defaultWriterState
110 epochtime <- floor `fmap` getPOSIXTime
110 epochtime <- floor `fmap` getPOSIXTime
111 let imgs = M.elems $ stImages st
111 let imgs = M.elems $ stImages st
@@ -132,7 +132,14 @@ writeDocx opts doc@(Pandoc (Meta tit auths date) _) = do
132 let newrels' = map toLinkRel $ M.toList $ stExternalLinks st
132 let newrels' = map toLinkRel $ M.toList $ stExternalLinks st
133 let reldoc'' = reldoc' { elContent = elContent reldoc' ++ map Elem newrels' }
133 let reldoc'' = reldoc' { elContent = elContent reldoc' ++ map Elem newrels' }
134 let relEntry = toEntry relpath epochtime $ UTF8.fromStringLazy $ showTopElement' reldoc''
134 let relEntry = toEntry relpath epochtime $ UTF8.fromStringLazy $ showTopElement' reldoc''
135− let contentEntry = toEntry "word/document.xml" epochtime $ UTF8.fromStringLazy $ showTopElement' newContents
135+ let contentEntry = toEntry "word/document.xml" epochtime $ UTF8.fromStringLazy $ showTopElement' contents
137+ let footnotesEntry = toEntry "word/footnotes.xml" epochtime $ UTF8.fromStringLazy $
138+ showTopElement' footnotes
140+ let footnoteRelEntry = toEntry "word/_rels/footnotes.xml.rels" epochtime $ UTF8.fromStringLazy $
141+ showTopElement' $ mknode "Relationships" [("xmlns","http://schemas.openxmlformats.org/package/2006/relationships")]
136 -- styles
143 -- styles
137 let newstyles = styleToOpenXml $ writerHighlightStyle opts
144 let newstyles = styleToOpenXml $ writerHighlightStyle opts
138 let stylepath = "word/styles.xml"
145 let stylepath = "word/styles.xml"
@@ -170,7 +177,7 @@ writeDocx opts doc@(Pandoc (Meta tit auths date) _) = do
171 let relsEntry = toEntry relsPath epochtime $ UTF8.fromStringLazy rels'
178 let relsEntry = toEntry relsPath epochtime $ UTF8.fromStringLazy rels'
172 let archive = foldr addEntryToArchive refArchive $
179 let archive = foldr addEntryToArchive refArchive $
173− relsEntry : contentEntry : relEntry : numEntry : styleEntry : docPropsEntry : imageEntries
180+ relsEntry : contentEntry : relEntry : footnoteRelEntry : numEntry : styleEntry : footnotesEntry : docPropsEntry : imageEntries
174 return $ fromArchive archive
181 return $ fromArchive archive
176styleToOpenXml :: Style -> [Element]
183styleToOpenXml :: Style -> [Element]
@@ -284,8 +291,8 @@ mkLvl marker lvl =
284getNumId :: WS Int
291getNumId :: WS Int
285getNumId = length `fmap` gets stLists
292getNumId = length `fmap` gets stLists
287−-- | Convert Pandoc document to string in OpenXML format.
294+-- | Convert Pandoc document to two OpenXML elements (the main document and footnotes).
288−writeOpenXML :: WriterOptions -> Pandoc -> WS Element
295+writeOpenXML :: WriterOptions -> Pandoc -> WS (Element, Element)
289writeOpenXML opts (Pandoc (Meta tit auths dat) blocks) = do
296writeOpenXML opts (Pandoc (Meta tit auths dat) blocks) = do
290 title <- withParaProp (pStyle "Title") $ blocksToOpenXML opts [Para tit | not (null tit)]
297 title <- withParaProp (pStyle "Title") $ blocksToOpenXML opts [Para tit | not (null tit)]
291 authors <- withParaProp (pStyle "Authors") $ blocksToOpenXML opts
298 authors <- withParaProp (pStyle "Authors") $ blocksToOpenXML opts
@@ -295,13 +302,10 @@ writeOpenXML opts (Pandoc (Meta tit auths dat) blocks) = do
295 convertSpace (Str x : Str y : xs) = Str (x ++ y) : xs
302 convertSpace (Str x : Str y : xs) = Str (x ++ y) : xs
296 convertSpace xs = xs
303 convertSpace xs = xs
297 let blocks' = bottomUp convertSpace $ blocks
304 let blocks' = bottomUp convertSpace $ blocks
298− doc <- blocksToOpenXML opts blocks'
305+ doc' <- blocksToOpenXML opts blocks'
299 notes' <- reverse `fmap` gets stFootnotes
306 notes' <- reverse `fmap` gets stFootnotes
300− let notes = case notes' of
302− ns -> [mknode "w:footnotes" [] ns]
303 let meta = title ++ authors ++ date
307 let meta = title ++ authors ++ date
304− return $ mknode "w:document"
308+ let stdAttributes =
305 [("xmlns:w","http://schemas.openxmlformats.org/wordprocessingml/2006/main")
309 [("xmlns:w","http://schemas.openxmlformats.org/wordprocessingml/2006/main")
306 ,("xmlns:m","http://schemas.openxmlformats.org/officeDocument/2006/math")
310 ,("xmlns:m","http://schemas.openxmlformats.org/officeDocument/2006/math")
307 ,("xmlns:r","http://schemas.openxmlformats.org/officeDocument/2006/relationships")
311 ,("xmlns:r","http://schemas.openxmlformats.org/officeDocument/2006/relationships")
@@ -311,7 +315,9 @@ writeOpenXML opts (Pandoc (Meta tit auths dat) blocks) = do
311 ,("xmlns:a","http://schemas.openxmlformats.org/drawingml/2006/main")
315 ,("xmlns:a","http://schemas.openxmlformats.org/drawingml/2006/main")
312 ,("xmlns:pic","http://schemas.openxmlformats.org/drawingml/2006/picture")
316 ,("xmlns:pic","http://schemas.openxmlformats.org/drawingml/2006/picture")
313 ,("xmlns:wp","http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing")]
317 ,("xmlns:wp","http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing")]
314− $ mknode "w:body" [] (meta ++ doc ++ notes)
318+ let doc = mknode "w:document" stdAttributes $ mknode "w:body" [] (meta ++ doc')
319+ let notes = mknode "w:footnotes" stdAttributes notes'
316-- | Convert a list of Pandoc blocks to OpenXML.
322-- | Convert a list of Pandoc blocks to OpenXML.
317blocksToOpenXML :: WriterOptions -> [Block] -> WS [Element]
323blocksToOpenXML :: WriterOptions -> [Block] -> WS [Element]
@@ -323,6 +329,11 @@ pStyle sty = mknode "w:pStyle" [("w:val",sty)] ()
323rStyle :: String -> Element
329rStyle :: String -> Element
324rStyle sty = mknode "w:rStyle" [("w:val",sty)] ()
330rStyle sty = mknode "w:rStyle" [("w:val",sty)] ()
332+getUniqueId :: MonadIO m => m String
333+-- the + 20 is to ensure that there are no clashes with the rIds
334+-- already in word/document.xml.rel
335+getUniqueId = liftIO $ (show . (+ 20) . hashUnique) `fmap` newUnique
326-- | Convert a Pandoc block element to OpenXML.
337-- | Convert a Pandoc block element to OpenXML.
327blockToOpenXML :: WriterOptions -> Block -> WS [Element]
338blockToOpenXML :: WriterOptions -> Block -> WS [Element]
328blockToOpenXML _ Null = return []
339blockToOpenXML _ Null = return []
@@ -332,10 +343,10 @@ blockToOpenXML opts (Header lev lst) = do
332 usedIdents <- gets stSectionIds
343 usedIdents <- gets stSectionIds
333 let bookmarkName = uniqueIdent lst usedIdents
344 let bookmarkName = uniqueIdent lst usedIdents
334 modify $ \s -> s{ stSectionIds = bookmarkName : stSectionIds s }
345 modify $ \s -> s{ stSectionIds = bookmarkName : stSectionIds s }
335− id' <- liftIO $ hashUnique `fmap` newUnique
346+ id' <- getUniqueId
336− let bookmarkStart = mknode "w:bookmarkStart" [("w:id",show id')
347+ let bookmarkStart = mknode "w:bookmarkStart" [("w:id", id')
337 ,("w:name",bookmarkName)] ()
348 ,("w:name",bookmarkName)] ()
338− let bookmarkEnd = mknode "w:bookmarkEnd" [("w:id",show id')] ()
349+ let bookmarkEnd = mknode "w:bookmarkEnd" [("w:id", id')] ()
339 return $ [bookmarkStart] ++ contents ++ [bookmarkEnd]
350 return $ [bookmarkStart] ++ contents ++ [bookmarkEnd]
340blockToOpenXML opts (Plain lst) = blockToOpenXML opts (Para lst)
351blockToOpenXML opts (Plain lst) = blockToOpenXML opts (Para lst)
341blockToOpenXML opts (Para x@[Image alt _]) = do
352blockToOpenXML opts (Para x@[Image alt _]) = do
@@ -572,7 +583,7 @@ inlineToOpenXML _ (Code attrs str) =
572 , mknode "w:t" [("xml:space","preserve")] tok ]
583 , mknode "w:t" [("xml:space","preserve")] tok ]
573inlineToOpenXML opts (Note bs) = do
584inlineToOpenXML opts (Note bs) = do
574 notes <- gets stFootnotes
585 notes <- gets stFootnotes
575− notenum <- liftIO $ hashUnique `fmap` newUnique
586+ notenum <- getUniqueId
576 let notemarker = mknode "w:r" []
587 let notemarker = mknode "w:r" []
577 [ mknode "w:rPr" [] (rStyle "FootnoteReference")
588 [ mknode "w:rPr" [] (rStyle "FootnoteReference")
578 , mknode "w:footnoteRef" [] () ]
589 , mknode "w:footnoteRef" [] () ]
@@ -588,11 +599,11 @@ inlineToOpenXML opts (Note bs) = do
588 $ insertNoteRef bs
599 $ insertNoteRef bs
589 modify $ \st -> st{ stListLevel = oldListLevel, stParaProperties = oldParaProperties,
600 modify $ \st -> st{ stListLevel = oldListLevel, stParaProperties = oldParaProperties,
590 stTextProperties = oldTextProperties }
601 stTextProperties = oldTextProperties }
591− let newnote = mknode "w:footnote" [("w:id",show notenum)] $ contents
602+ let newnote = mknode "w:footnote" [("w:id", notenum)] $ contents
592 modify $ \s -> s{ stFootnotes = newnote : notes }
603 modify $ \s -> s{ stFootnotes = newnote : notes }
593 return [ mknode "w:r" []
604 return [ mknode "w:r" []
594 [ mknode "w:rPr" [] (rStyle "FootnoteReference")
605 [ mknode "w:rPr" [] (rStyle "FootnoteReference")
595− , mknode "w:footnoteReference" [("w:id", show notenum)] () ] ]
606+ , mknode "w:footnoteReference" [("w:id", notenum)] () ] ]
596-- internal link:
607-- internal link:
597inlineToOpenXML opts (Link txt ('#':xs,_)) = do
608inlineToOpenXML opts (Link txt ('#':xs,_)) = do
598 contents <- withTextProp (rStyle "Hyperlink") $ inlinesToOpenXML opts txt
609 contents <- withTextProp (rStyle "Hyperlink") $ inlinesToOpenXML opts txt
@@ -601,14 +612,14 @@ inlineToOpenXML opts (Link txt ('#':xs,_)) = do
601inlineToOpenXML opts (Link txt (src,_)) = do
612inlineToOpenXML opts (Link txt (src,_)) = do
602 contents <- withTextProp (rStyle "Hyperlink") $ inlinesToOpenXML opts txt
613 contents <- withTextProp (rStyle "Hyperlink") $ inlinesToOpenXML opts txt
603 extlinks <- gets stExternalLinks
614 extlinks <- gets stExternalLinks
604− ind <- case M.lookup src extlinks of
615+ id' <- case M.lookup src extlinks of
605 Just i -> return i
616 Just i -> return i
606 Nothing -> do
617 Nothing -> do
607− let i = "link" ++ show (M.size extlinks)
618+ i <- ("rId"++) `fmap` getUniqueId
608 modify $ \st -> st{ stExternalLinks =
619 modify $ \st -> st{ stExternalLinks =
609 M.insert src i extlinks }
620 M.insert src i extlinks }
611− return [ mknode "w:hyperlink" [("r:id",ind)] contents ]
622+ return [ mknode "w:hyperlink" [("r:id",id')] contents ]
612inlineToOpenXML opts (Image alt (src, tit)) = do
623inlineToOpenXML opts (Image alt (src, tit)) = do
613 exists <- liftIO $ doesFileExist src
624 exists <- liftIO $ doesFileExist src
614 if exists
625 if exists
@@ -618,7 +629,7 @@ inlineToOpenXML opts (Image alt (src, tit)) = do
618 Just (i,img) -> return (i, imageSize img)
629 Just (i,img) -> return (i, imageSize img)
619 Nothing -> do
630 Nothing -> do
620 img <- liftIO $ B.readFile src
631 img <- liftIO $ B.readFile src
621− let ident' = "image" ++ show (M.size imgs + 1)
632+ ident' <- getUniqueId
622 let size' = imageSize img
633 let size' = imageSize img
623 modify $ \st -> st{
634 modify $ \st -> st{
624 stImages = M.insert src (ident',img) $ stImages st }
635 stImages = M.insert src (ident',img) $ stImages st }