aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Readers/Docx.hs16
-rw-r--r--src/Text/Pandoc/Readers/Docx/Parse.hs58
2 files changed, 73 insertions, 1 deletions
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs
index 9c7c3b264..610477f02 100644
--- a/src/Text/Pandoc/Readers/Docx.hs
+++ b/src/Text/Pandoc/Readers/Docx.hs
@@ -339,6 +339,22 @@ parPartToInlines (Deletion _ author date runs) = do
ils <- smushInlines <$> mapM runToInlines runs
let attr = ("", ["deletion"], [("author", author), ("date", date)])
return $ spanWith attr ils
+parPartToInlines (CommentStart cmtId author date bodyParts) = do
+ opts <- asks docxOptions
+ case readerTrackChanges opts of
+ AllChanges -> do
+ blks <- smushBlocks <$> mapM bodyPartToBlocks bodyParts
+ let ils = fromList $ blocksToInlines $ toList blks
+ attr = ("", ["comment-start"], [("id", cmtId), ("author", author), ("date", date)])
+ return $ spanWith attr ils
+ _ -> return mempty
+parPartToInlines (CommentEnd cmtId) = do
+ opts <- asks docxOptions
+ case readerTrackChanges opts of
+ AllChanges -> do
+ let attr = ("", ["comment-end"], [("id", cmtId)])
+ return $ spanWith attr mempty
+ _ -> return mempty
parPartToInlines (BookMark _ anchor) | anchor `elem` dummyAnchors =
return mempty
parPartToInlines (BookMark _ anchor) =
diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs
index 7265ef8dd..055a67288 100644
--- a/src/Text/Pandoc/Readers/Docx/Parse.hs
+++ b/src/Text/Pandoc/Readers/Docx/Parse.hs
@@ -73,6 +73,7 @@ import Text.Pandoc.Readers.Docx.Util
import Data.Char (readLitChar, ord, chr, isDigit)
data ReaderEnv = ReaderEnv { envNotes :: Notes
+ , envComments :: Comments
, envNumbering :: Numbering
, envRelationships :: [Relationship]
, envMedia :: Media
@@ -160,6 +161,9 @@ data Notes = Notes NameSpaces
(Maybe (M.Map String Element))
deriving Show
+data Comments = Comments NameSpaces (M.Map String Element)
+ deriving Show
+
data ParIndentation = ParIndentation { leftParIndent :: Maybe Integer
, rightParIndent :: Maybe Integer
, hangingParIndent :: Maybe Integer}
@@ -210,6 +214,8 @@ type Extent = Maybe (Double, Double)
data ParPart = PlainRun Run
| Insertion ChangeId Author ChangeDate [Run]
| Deletion ChangeId Author ChangeDate [Run]
+ | CommentStart CommentId Author CommentDate [BodyPart]
+ | CommentEnd CommentId
| BookMark BookMarkId Anchor
| InternalHyperLink Anchor [Run]
| ExternalHyperLink URL [Run]
@@ -259,8 +265,10 @@ type URL = String
type BookMarkId = String
type RelId = String
type ChangeId = String
+type CommentId = String
type Author = String
type ChangeDate = String
+type CommentDate = String
archiveToDocx :: Archive -> Either DocxError Docx
archiveToDocx archive = fst <$> archiveToDocxWithWarnings archive
@@ -268,12 +276,13 @@ archiveToDocx archive = fst <$> archiveToDocxWithWarnings archive
archiveToDocxWithWarnings :: Archive -> Either DocxError (Docx, [String])
archiveToDocxWithWarnings archive = do
let notes = archiveToNotes archive
+ comments = archiveToComments archive
numbering = archiveToNumbering archive
rels = archiveToRelationships archive
media = archiveToMedia archive
(styles, parstyles) = archiveToStyles archive
rEnv =
- ReaderEnv notes numbering rels media Nothing styles parstyles InDocument
+ ReaderEnv notes comments numbering rels media Nothing styles parstyles InDocument
rState = ReaderState { stateWarnings = [] }
(eitherDoc, st) = runD (archiveToDocument archive) rEnv rState
case eitherDoc of
@@ -384,6 +393,20 @@ archiveToNotes zf =
in
Notes ns fn en
+archiveToComments :: Archive -> Comments
+archiveToComments zf =
+ let cmtsElem = findEntryByPath "word/comments.xml" zf
+ >>= (parseXMLDoc . UTF8.toStringLazy . fromEntry)
+ cmts_namespaces = case cmtsElem of
+ Just e -> elemToNameSpaces e
+ Nothing -> []
+ cmts = (elemToComments cmts_namespaces) <$> cmtsElem
+ in
+ case cmts of
+ Just c -> Comments cmts_namespaces c
+ Nothing -> Comments cmts_namespaces M.empty
+
+
filePathToRelType :: FilePath -> Maybe DocumentLocation
filePathToRelType "word/_rels/document.xml.rels" = Just InDocument
filePathToRelType "word/_rels/footnotes.xml.rels" = Just InFootnote
@@ -504,6 +527,18 @@ elemToNotes ns notetype element
Just $ M.fromList $ pairs
elemToNotes _ _ _ = Nothing
+elemToComments :: NameSpaces -> Element -> M.Map String Element
+elemToComments ns element
+ | isElem ns "w" "comments" element =
+ let pairs = mapMaybe
+ (\e -> findAttr (elemName ns "w" "id") e >>=
+ (\a -> Just (a, e)))
+ (findChildren (elemName ns "w" "comment") element)
+ in
+ M.fromList $ pairs
+elemToComments _ _ = M.empty
+
+
---------------------------------------------
---------------------------------------------
@@ -697,10 +732,31 @@ elemToParPart ns element
runs <- mapD (elemToRun ns) (elChildren element)
return $ InternalHyperLink anchor runs
elemToParPart ns element
+ | isElem ns "w" "commentRangeStart" element
+ , Just cmtId <- findAttr (elemName ns "w" "id") element = do
+ (Comments _ commentMap) <- asks envComments
+ case M.lookup cmtId commentMap of
+ Just cmtElem -> elemToCommentStart ns cmtElem
+ Nothing -> throwError WrongElem
+elemToParPart ns element
+ | isElem ns "w" "commentRangeEnd" element
+ , Just cmtId <- findAttr (elemName ns "w" "id") element =
+ return $ CommentEnd cmtId
+elemToParPart ns element
| isElem ns "m" "oMath" element =
(eitherToD $ readOMML $ showElement element) >>= (return . PlainOMath)
elemToParPart _ _ = throwError WrongElem
+elemToCommentStart :: NameSpaces -> Element -> D ParPart
+elemToCommentStart ns element
+ | isElem ns "w" "comment" element
+ , Just cmtId <- findAttr (elemName ns "w" "id") element
+ , Just cmtAuthor <- findAttr (elemName ns "w" "author") element
+ , Just cmtDate <- findAttr (elemName ns "w" "date") element = do
+ bps <- mapD (elemToBodyPart ns) (elChildren element)
+ return $ CommentStart cmtId cmtAuthor cmtDate bps
+elemToCommentStart _ _ = throwError WrongElem
+
lookupFootnote :: String -> Notes -> Maybe Element
lookupFootnote s (Notes _ fns _) = fns >>= (M.lookup s)