@@ -105,7 +105,7 @@ writeDocx opts doc@(Pandoc (Meta tit auths date) _) = do
105105 Nothing -> (B.fromChunks . (:[])) `fmap`
106106 readDataFile datadir "reference.docx"
107107
108− (newContents, st) <- runStateT (writeOpenXML opts{writerWrapText = False} doc)
108+ ((contents, footnotes), st) <- runStateT (writeOpenXML opts{writerWrapText = False} doc)
109109 defaultWriterState
110110 epochtime <- floor `fmap` getPOSIXTime
111111 let imgs = M.elems $ stImages st
@@ -132,7 +132,14 @@ writeDocx opts doc@(Pandoc (Meta tit auths date) _) = do
132132 let newrels' = map toLinkRel $ M.toList $ stExternalLinks st
133133 let reldoc'' = reldoc' { elContent = elContent reldoc' ++ map Elem newrels' }
134134 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
136+ -- footnotes
137+ let footnotesEntry = toEntry "word/footnotes.xml" epochtime $ UTF8.fromStringLazy $
138+ showTopElement' footnotes
139+ -- footnote rels
140+ let footnoteRelEntry = toEntry "word/_rels/footnotes.xml.rels" epochtime $ UTF8.fromStringLazy $
141+ showTopElement' $ mknode "Relationships" [("xmlns","http://schemas.openxmlformats.org/package/2006/relationships")]
142+ $ newrels'
136143 -- styles
137144 let newstyles = styleToOpenXml $ writerHighlightStyle opts
138145 let stylepath = "word/styles.xml"
@@ -170,7 +177,7 @@ writeDocx opts doc@(Pandoc (Meta tit auths date) _) = do
170177 rels
171178 let relsEntry = toEntry relsPath epochtime $ UTF8.fromStringLazy rels'
172179 let archive = foldr addEntryToArchive refArchive $
173− relsEntry : contentEntry : relEntry : numEntry : styleEntry : docPropsEntry : imageEntries
180+ relsEntry : contentEntry : relEntry : footnoteRelEntry : numEntry : styleEntry : footnotesEntry : docPropsEntry : imageEntries
174181 return $ fromArchive archive
175182
176183styleToOpenXml :: Style -> [Element]
@@ -284,8 +291,8 @@ mkLvl marker lvl =
284291getNumId :: WS Int
285292getNumId = length `fmap` gets stLists
286293
287−-- | Convert Pandoc document to string in OpenXML format.
288−writeOpenXML :: WriterOptions -> Pandoc -> WS Element
294+-- | Convert Pandoc document to two OpenXML elements (the main document and footnotes).
295+writeOpenXML :: WriterOptions -> Pandoc -> WS (Element, Element)
289296writeOpenXML opts (Pandoc (Meta tit auths dat) blocks) = do
290297 title <- withParaProp (pStyle "Title") $ blocksToOpenXML opts [Para tit | not (null tit)]
291298 authors <- withParaProp (pStyle "Authors") $ blocksToOpenXML opts
@@ -295,13 +302,10 @@ writeOpenXML opts (Pandoc (Meta tit auths dat) blocks) = do
295302 convertSpace (Str x : Str y : xs) = Str (x ++ y) : xs
296303 convertSpace xs = xs
297304 let blocks' = bottomUp convertSpace $ blocks
298− doc <- blocksToOpenXML opts blocks'
305+ doc' <- blocksToOpenXML opts blocks'
299306 notes' <- reverse `fmap` gets stFootnotes
300− let notes = case notes' of
301− [] -> []
302− ns -> [mknode "w:footnotes" [] ns]
303307 let meta = title ++ authors ++ date
304− return $ mknode "w:document"
308+ let stdAttributes =
305309 [("xmlns:w","http://schemas.openxmlformats.org/wordprocessingml/2006/main")
306310 ,("xmlns:m","http://schemas.openxmlformats.org/officeDocument/2006/math")
307311 ,("xmlns:r","http://schemas.openxmlformats.org/officeDocument/2006/relationships")
@@ -311,7 +315,9 @@ writeOpenXML opts (Pandoc (Meta tit auths dat) blocks) = do
311315 ,("xmlns:a","http://schemas.openxmlformats.org/drawingml/2006/main")
312316 ,("xmlns:pic","http://schemas.openxmlformats.org/drawingml/2006/picture")
313317 ,("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'
320+ return (doc, notes)
315321
316322-- | Convert a list of Pandoc blocks to OpenXML.
317323blocksToOpenXML :: WriterOptions -> [Block] -> WS [Element]
@@ -323,6 +329,11 @@ pStyle sty = mknode "w:pStyle" [("w:val",sty)] ()
323329rStyle :: String -> Element
324330rStyle sty = mknode "w:rStyle" [("w:val",sty)] ()
325331
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
336+
326337-- | Convert a Pandoc block element to OpenXML.
327338blockToOpenXML :: WriterOptions -> Block -> WS [Element]
328339blockToOpenXML _ Null = return []
@@ -332,10 +343,10 @@ blockToOpenXML opts (Header lev lst) = do
332343 usedIdents <- gets stSectionIds
333344 let bookmarkName = uniqueIdent lst usedIdents
334345 modify $ \s -> s{ stSectionIds = bookmarkName : stSectionIds s }
335− id' <- liftIO $ hashUnique `fmap` newUnique
336− let bookmarkStart = mknode "w:bookmarkStart" [("w:id",show id')
346+ id' <- getUniqueId
347+ let bookmarkStart = mknode "w:bookmarkStart" [("w:id", id')
337348 ,("w:name",bookmarkName)] ()
338− let bookmarkEnd = mknode "w:bookmarkEnd" [("w:id",show id')] ()
349+ let bookmarkEnd = mknode "w:bookmarkEnd" [("w:id", id')] ()
339350 return $ [bookmarkStart] ++ contents ++ [bookmarkEnd]
340351blockToOpenXML opts (Plain lst) = blockToOpenXML opts (Para lst)
341352blockToOpenXML opts (Para x@[Image alt _]) = do
@@ -572,7 +583,7 @@ inlineToOpenXML _ (Code attrs str) =
572583 , mknode "w:t" [("xml:space","preserve")] tok ]
573584inlineToOpenXML opts (Note bs) = do
574585 notes <- gets stFootnotes
575− notenum <- liftIO $ hashUnique `fmap` newUnique
586+ notenum <- getUniqueId
576587 let notemarker = mknode "w:r" []
577588 [ mknode "w:rPr" [] (rStyle "FootnoteReference")
578589 , mknode "w:footnoteRef" [] () ]
@@ -588,11 +599,11 @@ inlineToOpenXML opts (Note bs) = do
588599 $ insertNoteRef bs
589600 modify $ \st -> st{ stListLevel = oldListLevel, stParaProperties = oldParaProperties,
590601 stTextProperties = oldTextProperties }
591− let newnote = mknode "w:footnote" [("w:id",show notenum)] $ contents
602+ let newnote = mknode "w:footnote" [("w:id", notenum)] $ contents
592603 modify $ \s -> s{ stFootnotes = newnote : notes }
593604 return [ mknode "w:r" []
594605 [ mknode "w:rPr" [] (rStyle "FootnoteReference")
595− , mknode "w:footnoteReference" [("w:id", show notenum)] () ] ]
606+ , mknode "w:footnoteReference" [("w:id", notenum)] () ] ]
596607-- internal link:
597608inlineToOpenXML opts (Link txt ('#':xs,_)) = do
598609 contents <- withTextProp (rStyle "Hyperlink") $ inlinesToOpenXML opts txt
@@ -601,14 +612,14 @@ inlineToOpenXML opts (Link txt ('#':xs,_)) = do
601612inlineToOpenXML opts (Link txt (src,_)) = do
602613 contents <- withTextProp (rStyle "Hyperlink") $ inlinesToOpenXML opts txt
603614 extlinks <- gets stExternalLinks
604− ind <- case M.lookup src extlinks of
615+ id' <- case M.lookup src extlinks of
605616 Just i -> return i
606617 Nothing -> do
607− let i = "link" ++ show (M.size extlinks)
618+ i <- ("rId"++) `fmap` getUniqueId
608619 modify $ \st -> st{ stExternalLinks =
609620 M.insert src i extlinks }
610621 return i
611− return [ mknode "w:hyperlink" [("r:id",ind)] contents ]
622+ return [ mknode "w:hyperlink" [("r:id",id')] contents ]
612623inlineToOpenXML opts (Image alt (src, tit)) = do
613624 exists <- liftIO $ doesFileExist src
614625 if exists
@@ -618,7 +629,7 @@ inlineToOpenXML opts (Image alt (src, tit)) = do
618629 Just (i,img) -> return (i, imageSize img)
619630 Nothing -> do
620631 img <- liftIO $ B.readFile src
621− let ident' = "image" ++ show (M.size imgs + 1)
632+ ident' <- getUniqueId
622633 let size' = imageSize img
623634 modify $ \st -> st{
624635 stImages = M.insert src (ident',img) $ stImages st }