@@ -123,6 +123,7 @@ defaultWriterEnv = WriterEnv{ envTextProperties = []
123123
124124data WriterState = WriterState{
125125 stFootnotes :: [Element]
126+ , stComments :: [([(String,String)], [Inline])]
126127 , stSectionIds :: Set.Set String
127128 , stExternalLinks :: M.Map String String
128129 , stImages :: M.Map FilePath (String, String, Maybe MimeType, Element, B.ByteString)
@@ -139,6 +140,7 @@ data WriterState = WriterState{
139140defaultWriterState :: WriterState
140141defaultWriterState = WriterState{
141142 stFootnotes = defaultFootnotes
143+ , stComments = []
142144 , stSectionIds = Set.empty
143145 , stExternalLinks = M.empty
144146 , stImages = M.empty
@@ -305,11 +307,11 @@ writeDocx opts doc@(Pandoc meta _) = do
305307 }
306308
307309
308− ((contents, footnotes), st) <- runStateT
309− (runReaderT
310− (writeOpenXML opts{writerWrapText = WrapNone} doc')
311− env)
312− initialSt
310+ ((contents, footnotes, comments), st) <- runStateT
311+ (runReaderT
312+ (writeOpenXML opts{writerWrapText = WrapNone} doc')
313+ env)
314+ initialSt
313315 let epochtime = floor $ utcTimeToPOSIXSeconds utctime
314316 let imgs = M.elems $ stImages st
315317
@@ -370,6 +372,8 @@ writeDocx opts doc@(Pandoc meta _) = do
370372 "application/vnd.openxmlformats-officedocument.wordprocessingml.styles+xml")
371373 ,("/word/document.xml",
372374 "application/vnd.openxmlformats-officedocument.wordprocessingml.document.main+xml")
375+ ,("/word/comments.xml",
376+ "application/vnd.openxmlformats-officedocument.wordprocessingml.comments+xml")
373377 ,("/word/footnotes.xml",
374378 "application/vnd.openxmlformats-officedocument.wordprocessingml.footnotes+xml")
375379 ] ++
@@ -416,6 +420,9 @@ writeDocx opts doc@(Pandoc meta _) = do
416420 ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/footnotes",
417421 "rId7",
418422 "footnotes.xml")
423+ ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments",
424+ "rId8",
425+ "comments.xml")
419426 ]
420427
421428 let idMap = renumIdMap (length baserels' + 1) (headers ++ footers)
@@ -461,6 +468,10 @@ writeDocx opts doc@(Pandoc meta _) = do
461468 $ renderXml $ mknode "Relationships" [("xmlns","http://schemas.openxmlformats.org/package/2006/relationships")]
462469 linkrels
463470
471+ -- comments
472+ let commentsEntry = toEntry "word/comments.xml" epochtime
473+ $ renderXml $ mknode "w:comments" stdAttributes comments
474+
464475 -- styles
465476
466477 -- We only want to inject paragraph and text properties that
@@ -564,6 +575,7 @@ writeDocx opts doc@(Pandoc meta _) = do
564575 let archive = foldr addEntryToArchive emptyArchive $
565576 contentTypesEntry : relsEntry : contentEntry : relEntry :
566577 footnoteRelEntry : numEntry : styleEntry : footnotesEntry :
578+ commentsEntry :
567579 docPropsEntry : docPropsAppEntry : themeEntry :
568580 fontTableEntry : settingsEntry : webSettingsEntry :
569581 imageEntries ++ headerFooterEntries ++
@@ -762,7 +774,7 @@ makeTOC _ = return []
762774
763775-- | Convert Pandoc document to two lists of
764776-- OpenXML elements (the main document and footnotes).
765−writeOpenXML :: (PandocMonad m) => WriterOptions -> Pandoc -> WS m ([Element], [Element])
777+writeOpenXML :: (PandocMonad m) => WriterOptions -> Pandoc -> WS m ([Element], [Element],[Element])
766778writeOpenXML opts (Pandoc meta blocks) = do
767779 let tit = docTitle meta ++ case lookupMeta "subtitle" meta of
768780 Just (MetaBlocks [Plain xs]) -> LineBreak : xs
@@ -791,10 +803,27 @@ writeOpenXML opts (Pandoc meta blocks) = do
791803 convertSpace xs = xs
792804 let blocks' = bottomUp convertSpace blocks
793805 doc' <- (setFirstPara >> blocksToOpenXML opts blocks')
794− notes' <- reverse `fmap` gets stFootnotes
806+ notes' <- reverse <$> gets stFootnotes
807+ comments <- reverse <$> gets stComments
808+ let toComment (kvs, ils) = do
809+ annotation <- inlinesToOpenXML opts ils
810+ return $
811+ mknode "w:comment" [('w':':':k,v) | (k,v) <- kvs]
812+ [ mknode "w:p" [] $
813+ [ mknode "w:pPr" []
814+ [ mknode "w:pStyle" [("w:val", "CommentText")] () ]
815+ , mknode "w:r" []
816+ [ mknode "w:rPr" []
817+ [ mknode "w:rStyle" [("w:val", "CommentReference")] ()
818+ , mknode "w:annotationRef" [] ()
819+ ]
820+ ]
821+ ] ++ annotation
822+ ]
823+ comments' <- mapM toComment comments
795824 toc <- makeTOC opts
796825 let meta' = title ++ subtitle ++ authors ++ date ++ abstract ++ toc
797− return (meta' ++ doc', notes')
826+ return (meta' ++ doc', notes', comments')
798827
799828-- | Convert a list of Pandoc blocks to OpenXML.
800829blocksToOpenXML :: (PandocMonad m) => WriterOptions -> [Block] -> WS m [Element]
@@ -1101,6 +1130,16 @@ inlineToOpenXML' _ (Str str) =
11011130 formattedString str
11021131inlineToOpenXML' opts Space = inlineToOpenXML opts (Str " ")
11031132inlineToOpenXML' opts SoftBreak = inlineToOpenXML opts (Str " ")
1133+inlineToOpenXML' _ (Span (ident,["comment-start"],kvs) ils) = do
1134+ modify $ \st -> st{ stComments = (("id",ident):kvs, ils) : stComments st }
1135+ return [ mknode "w:commentRangeStart" [("w:id", ident)] () ]
1136+inlineToOpenXML' _ (Span (ident,["comment-end"],_) _) = do
1137+ return [ mknode "w:commentRangeEnd" [("w:id", ident)] ()
1138+ , mknode "w:r" []
1139+ [ mknode "w:rPr" []
1140+ [ mknode "w:rStyle" [("w:val", "CommentReference")] () ]
1141+ , mknode "w:commentReference" [("w:id", ident)] () ]
1142+ ]
11041143inlineToOpenXML' opts (Span (ident,classes,kvs) ils) = do
11051144 stylemod <- case lookup dynamicStyleKey kvs of
11061145 Just sty -> do