diff options
| -rw-r--r-- | pandoc.cabal | 1 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Docx.hs | 55 | ||||
| -rw-r--r-- | test/command/2994.docx | bin | 0 -> 9701 bytes | |||
| -rw-r--r-- | test/command/2994.md | 7 |
4 files changed, 55 insertions, 8 deletions
diff --git a/pandoc.cabal b/pandoc.cabal index 9392b4430..39a390dd6 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -138,6 +138,7 @@ Extra-Source-Files: test/*.native test/command/*.md test/command/3533-rst-csv-tables.csv + test/command/2994.docx test/command/abbrevs test/command/SVG_logo-without-xml-declaration.svg test/command/SVG_logo.svg diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 8b19f3740..51e4ffb98 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -123,6 +123,7 @@ defaultWriterEnv = WriterEnv{ envTextProperties = [] data WriterState = WriterState{ stFootnotes :: [Element] + , stComments :: [([(String,String)], [Inline])] , stSectionIds :: Set.Set String , stExternalLinks :: M.Map String String , stImages :: M.Map FilePath (String, String, Maybe MimeType, Element, B.ByteString) @@ -139,6 +140,7 @@ data WriterState = WriterState{ defaultWriterState :: WriterState defaultWriterState = WriterState{ stFootnotes = defaultFootnotes + , stComments = [] , stSectionIds = Set.empty , stExternalLinks = M.empty , stImages = M.empty @@ -305,11 +307,11 @@ writeDocx opts doc@(Pandoc meta _) = do } - ((contents, footnotes), st) <- runStateT - (runReaderT - (writeOpenXML opts{writerWrapText = WrapNone} doc') - env) - initialSt + ((contents, footnotes, comments), st) <- runStateT + (runReaderT + (writeOpenXML opts{writerWrapText = WrapNone} doc') + env) + initialSt let epochtime = floor $ utcTimeToPOSIXSeconds utctime let imgs = M.elems $ stImages st @@ -370,6 +372,8 @@ writeDocx opts doc@(Pandoc meta _) = do "application/vnd.openxmlformats-officedocument.wordprocessingml.styles+xml") ,("/word/document.xml", "application/vnd.openxmlformats-officedocument.wordprocessingml.document.main+xml") + ,("/word/comments.xml", + "application/vnd.openxmlformats-officedocument.wordprocessingml.comments+xml") ,("/word/footnotes.xml", "application/vnd.openxmlformats-officedocument.wordprocessingml.footnotes+xml") ] ++ @@ -416,6 +420,9 @@ writeDocx opts doc@(Pandoc meta _) = do ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/footnotes", "rId7", "footnotes.xml") + ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments", + "rId8", + "comments.xml") ] let idMap = renumIdMap (length baserels' + 1) (headers ++ footers) @@ -461,6 +468,10 @@ writeDocx opts doc@(Pandoc meta _) = do $ renderXml $ mknode "Relationships" [("xmlns","http://schemas.openxmlformats.org/package/2006/relationships")] linkrels + -- comments + let commentsEntry = toEntry "word/comments.xml" epochtime + $ renderXml $ mknode "w:comments" stdAttributes comments + -- styles -- We only want to inject paragraph and text properties that @@ -564,6 +575,7 @@ writeDocx opts doc@(Pandoc meta _) = do let archive = foldr addEntryToArchive emptyArchive $ contentTypesEntry : relsEntry : contentEntry : relEntry : footnoteRelEntry : numEntry : styleEntry : footnotesEntry : + commentsEntry : docPropsEntry : docPropsAppEntry : themeEntry : fontTableEntry : settingsEntry : webSettingsEntry : imageEntries ++ headerFooterEntries ++ @@ -762,7 +774,7 @@ makeTOC _ = return [] -- | Convert Pandoc document to two lists of -- OpenXML elements (the main document and footnotes). -writeOpenXML :: (PandocMonad m) => WriterOptions -> Pandoc -> WS m ([Element], [Element]) +writeOpenXML :: (PandocMonad m) => WriterOptions -> Pandoc -> WS m ([Element], [Element],[Element]) writeOpenXML opts (Pandoc meta blocks) = do let tit = docTitle meta ++ case lookupMeta "subtitle" meta of Just (MetaBlocks [Plain xs]) -> LineBreak : xs @@ -791,10 +803,27 @@ writeOpenXML opts (Pandoc meta blocks) = do convertSpace xs = xs let blocks' = bottomUp convertSpace blocks doc' <- (setFirstPara >> blocksToOpenXML opts blocks') - notes' <- reverse `fmap` gets stFootnotes + notes' <- reverse <$> gets stFootnotes + comments <- reverse <$> gets stComments + let toComment (kvs, ils) = do + annotation <- inlinesToOpenXML opts ils + return $ + mknode "w:comment" [('w':':':k,v) | (k,v) <- kvs] + [ mknode "w:p" [] $ + [ mknode "w:pPr" [] + [ mknode "w:pStyle" [("w:val", "CommentText")] () ] + , mknode "w:r" [] + [ mknode "w:rPr" [] + [ mknode "w:rStyle" [("w:val", "CommentReference")] () + , mknode "w:annotationRef" [] () + ] + ] + ] ++ annotation + ] + comments' <- mapM toComment comments toc <- makeTOC opts let meta' = title ++ subtitle ++ authors ++ date ++ abstract ++ toc - return (meta' ++ doc', notes') + return (meta' ++ doc', notes', comments') -- | Convert a list of Pandoc blocks to OpenXML. blocksToOpenXML :: (PandocMonad m) => WriterOptions -> [Block] -> WS m [Element] @@ -1101,6 +1130,16 @@ inlineToOpenXML' _ (Str str) = formattedString str inlineToOpenXML' opts Space = inlineToOpenXML opts (Str " ") inlineToOpenXML' opts SoftBreak = inlineToOpenXML opts (Str " ") +inlineToOpenXML' _ (Span (ident,["comment-start"],kvs) ils) = do + modify $ \st -> st{ stComments = (("id",ident):kvs, ils) : stComments st } + return [ mknode "w:commentRangeStart" [("w:id", ident)] () ] +inlineToOpenXML' _ (Span (ident,["comment-end"],_) _) = do + return [ mknode "w:commentRangeEnd" [("w:id", ident)] () + , mknode "w:r" [] + [ mknode "w:rPr" [] + [ mknode "w:rStyle" [("w:val", "CommentReference")] () ] + , mknode "w:commentReference" [("w:id", ident)] () ] + ] inlineToOpenXML' opts (Span (ident,classes,kvs) ils) = do stylemod <- case lookup dynamicStyleKey kvs of Just sty -> do diff --git a/test/command/2994.docx b/test/command/2994.docx Binary files differnew file mode 100644 index 000000000..44118e9bd --- /dev/null +++ b/test/command/2994.docx diff --git a/test/command/2994.md b/test/command/2994.md new file mode 100644 index 000000000..b7d267d29 --- /dev/null +++ b/test/command/2994.md @@ -0,0 +1,7 @@ +``` +% pandoc --track-changes=all -t markdown command/2994.docx +^D +I want [I left a comment.]{.comment-start id="0" +author="Jesse Rosenthal" date="2016-05-09T16:13:00Z"}some text to have a +comment []{.comment-end id="0"}on it. +``` |