From e1bb28a3880e4d8b46f20510a89efb3830a590d6 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Mon, 25 Aug 2014 12:37:56 -0400 Subject: Docx writer: Implement track changes. These have default authors and dates of "unknown" and timestamp-zero, respectively. --- src/Text/Pandoc/Writers/Docx.hs | 49 +++++++++++++++++++++++++++++++++-------- 1 file changed, 40 insertions(+), 9 deletions(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index e437c948f..9436a4743 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ScopedTypeVariables, PatternGuards #-} {- Copyright (C) 2012-2014 John MacFarlane @@ -94,6 +94,9 @@ data WriterState = WriterState{ , stListLevel :: Int , stListNumId :: Int , stLists :: [ListMarker] + , stInsId :: Int + , stDelId :: Int + , stInDel :: Bool } defaultWriterState :: WriterState @@ -107,6 +110,9 @@ defaultWriterState = WriterState{ , stListLevel = -1 , stListNumId = 1 , stLists = [NoMarker] + , stInsId = 1 + , stDelId = 1 + , stInDel = False } type WS a = StateT WriterState IO a @@ -735,20 +741,45 @@ withParaProp d p = do formattedString :: String -> WS [Element] formattedString str = do props <- getTextProps + inDel <- gets stInDel return [ mknode "w:r" [] $ props ++ - [ mknode "w:t" [("xml:space","preserve")] str ] ] + [ mknode (if inDel then "w:delText" else "w:t") + [("xml:space","preserve")] str ] ] -- | Convert an inline element to OpenXML. inlineToOpenXML :: WriterOptions -> Inline -> WS [Element] inlineToOpenXML _ (Str str) = formattedString str inlineToOpenXML opts Space = inlineToOpenXML opts (Str " ") -inlineToOpenXML opts (Span (_,classes,_) ils) = do - let off x = withTextProp (mknode x [("w:val","0")] ()) - ((if "csl-no-emph" `elem` classes then off "w:i" else id) . - (if "csl-no-strong" `elem` classes then off "w:b" else id) . - (if "csl-no-smallcaps" `elem` classes then off "w:smallCaps" else id)) - $ inlinesToOpenXML opts ils +inlineToOpenXML opts (Span (_,classes,kvs) ils) + | "insertion" `elem` classes = do + let author = fromMaybe "unknown" (lookup "author" kvs) + date = fromMaybe "1969-12-31T19:00:00Z" (lookup "date" kvs) + insId <- gets stInsId + modify $ \s -> s{stInsId = (insId + 1)} + x <- inlinesToOpenXML opts ils + return [ mknode "w:ins" [("w:id", (show insId)), + ("w:author", author), + ("w:date", date)] + x ] + | "deletion" `elem` classes = do + let author = fromMaybe "unknown" (lookup "author" kvs) + date = fromMaybe "1969-12-31T19:00:00Z" (lookup "date" kvs) + delId <- gets stDelId + modify $ \s -> s{stDelId = (delId + 1)} + modify $ \s -> s{stInDel = True} + x <- inlinesToOpenXML opts ils + modify $ \s -> s{stInDel = False} + return [ mknode "w:del" [("w:id", (show delId)), + ("w:author", author), + ("w:date", date)] + x ] + | otherwise = do + let off x = withTextProp (mknode x [("w:val","0")] ()) + ((if "csl-no-emph" `elem` classes then off "w:i" else id) . + (if "csl-no-strong" `elem` classes then off "w:b" else id) . + (if "csl-no-smallcaps" `elem` classes then off "w:smallCaps" else id)) + $ inlinesToOpenXML opts ils inlineToOpenXML opts (Strong lst) = withTextProp (mknode "w:b" [] ()) $ inlinesToOpenXML opts lst inlineToOpenXML opts (Emph lst) = @@ -923,6 +954,6 @@ parseXml refArchive distArchive relpath = fitToPage :: (Integer, Integer) -> (Integer, Integer) fitToPage (x, y) --5440680 is the emu width size of a letter page in portrait, minus the margins - | x > 5440680 = + | x > 5440680 = (5440680, round $ (5440680 / ((fromIntegral :: Integer -> Double) x)) * (fromIntegral y)) | otherwise = (x, y) -- cgit v1.2.3 From 21253b59e803598014aa9b3769fbc353d279c698 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Mon, 25 Aug 2014 14:03:35 -0400 Subject: Docx writer: Default to user login and time of change if not given. --- src/Text/Pandoc/Writers/Docx.hs | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 9436a4743..1b7219895 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -38,6 +38,10 @@ import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.Compat.Monoid ((<>)) import Codec.Archive.Zip import Data.Time.Clock.POSIX +import Data.Time.Clock +import Data.Time.Format +import System.Environment +import System.Locale import Text.Pandoc.Definition import Text.Pandoc.Generic import Text.Pandoc.ImageSize @@ -97,6 +101,8 @@ data WriterState = WriterState{ , stInsId :: Int , stDelId :: Int , stInDel :: Bool + , stChangesAuthor :: String + , stChangesDate :: String } defaultWriterState :: WriterState @@ -113,6 +119,8 @@ defaultWriterState = WriterState{ , stInsId = 1 , stDelId = 1 , stInDel = False + , stChangesAuthor = "unknown" + , stChangesDate = "1969-12-31T19:00:00Z" } type WS a = StateT WriterState IO a @@ -141,6 +149,8 @@ writeDocx :: WriterOptions -- ^ Writer options writeDocx opts doc@(Pandoc meta _) = do let datadir = writerUserDataDir opts let doc' = walk fixDisplayMath doc + username <- lookupEnv "USERNAME" + utctime <- getCurrentTime refArchive <- liftM (toArchive . toLazy) $ case writerReferenceDocx opts of Just f -> B.readFile f @@ -148,8 +158,9 @@ writeDocx opts doc@(Pandoc meta _) = do distArchive <- liftM (toArchive . toLazy) $ readDataFile Nothing "reference.docx" ((contents, footnotes), st) <- runStateT (writeOpenXML opts{writerWrapText = False} doc') - defaultWriterState - epochtime <- floor `fmap` getPOSIXTime + defaultWriterState{ stChangesAuthor = fromMaybe "unknown" username + , stChangesDate = formatTime defaultTimeLocale "%FT%XZ" utctime} + let epochtime = floor $ utcTimeToPOSIXSeconds utctime let imgs = M.elems $ stImages st -- create entries for images in word/media/... @@ -753,8 +764,10 @@ inlineToOpenXML _ (Str str) = formattedString str inlineToOpenXML opts Space = inlineToOpenXML opts (Str " ") inlineToOpenXML opts (Span (_,classes,kvs) ils) | "insertion" `elem` classes = do - let author = fromMaybe "unknown" (lookup "author" kvs) - date = fromMaybe "1969-12-31T19:00:00Z" (lookup "date" kvs) + defaultAuthor <- gets stChangesAuthor + defaultDate <- gets stChangesDate + let author = fromMaybe defaultAuthor (lookup "author" kvs) + date = fromMaybe defaultDate (lookup "date" kvs) insId <- gets stInsId modify $ \s -> s{stInsId = (insId + 1)} x <- inlinesToOpenXML opts ils @@ -763,8 +776,10 @@ inlineToOpenXML opts (Span (_,classes,kvs) ils) ("w:date", date)] x ] | "deletion" `elem` classes = do - let author = fromMaybe "unknown" (lookup "author" kvs) - date = fromMaybe "1969-12-31T19:00:00Z" (lookup "date" kvs) + defaultAuthor <- gets stChangesAuthor + defaultDate <- gets stChangesDate + let author = fromMaybe defaultAuthor (lookup "author" kvs) + date = fromMaybe defaultDate (lookup "date" kvs) delId <- gets stDelId modify $ \s -> s{stDelId = (delId + 1)} modify $ \s -> s{stInDel = True} -- cgit v1.2.3 From b613d85af958a94d8c9b34868c7d67cbb606d725 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Tue, 26 Aug 2014 06:43:14 -0400 Subject: Docx writer: Accomodate GHC 7.4 (no lookupEnv) --- src/Text/Pandoc/Writers/Docx.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 1b7219895..687a85f9c 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -149,7 +149,7 @@ writeDocx :: WriterOptions -- ^ Writer options writeDocx opts doc@(Pandoc meta _) = do let datadir = writerUserDataDir opts let doc' = walk fixDisplayMath doc - username <- lookupEnv "USERNAME" + username <- lookup "USERNAME" <$> getEnvironment utctime <- getCurrentTime refArchive <- liftM (toArchive . toLazy) $ case writerReferenceDocx opts of -- cgit v1.2.3