@@ -50,13 +50,15 @@ plainToPara x = x
5050--
5151
5252data WriterState =
53− WriterState { stNotes :: [Doc]
54− , stTableStyles :: [Doc]
55− , stParaStyles :: [Doc]
56− , stListStyles :: [(Int, [Doc])]
57− , stIndentPara :: Int
58− , stInDefinition :: Bool
59− , stTight :: Bool
53+ WriterState { stNotes :: [Doc]
54+ , stTableStyles :: [Doc]
55+ , stParaStyles :: [Doc]
56+ , stListStyles :: [(Int, [Doc])]
57+ , stTextStyles :: [Doc]
58+ , stTextStyleAttr :: [(TextStyle,[(String,String)])]
59+ , stIndentPara :: Int
60+ , stInDefinition :: Bool
61+ , stTight :: Bool
6062 }
6163
6264defaultWriterState :: WriterState
@@ -65,6 +67,8 @@ defaultWriterState =
6567 , stTableStyles = []
6668 , stParaStyles = []
6769 , stListStyles = []
70+ , stTextStyles = []
71+ , stTextStyleAttr = []
6872 , stIndentPara = 0
6973 , stInDefinition = False
7074 , stTight = False
@@ -82,6 +86,16 @@ addNote i = modify $ \s -> s { stNotes = i : stNotes s }
8286addParaStyle :: Doc -> State WriterState ()
8387addParaStyle i = modify $ \s -> s { stParaStyles = i : stParaStyles s }
8488
89+addTextStyle :: Doc -> State WriterState ()
90+addTextStyle i = modify $ \s -> s { stTextStyles = i : stTextStyles s }
91+
92+addTextStyleAttr :: (TextStyle, [(String,String)]) -> State WriterState ()
93+addTextStyleAttr i = modify $ \s -> s { stTextStyleAttr = i : stTextStyleAttr s }
94+
95+rmTextStyleAttr :: State WriterState ()
96+rmTextStyleAttr = modify $ \s -> s { stTextStyleAttr = rmHead (stTextStyleAttr s) }
97+ where rmHead l = if l /= [] then tail l else []
98+
8599increaseIndent :: State WriterState ()
86100increaseIndent = modify $ \s -> s { stIndentPara = 1 + stIndentPara s }
87101
@@ -89,10 +103,8 @@ resetIndent :: State WriterState ()
89103resetIndent = modify $ \s -> s { stIndentPara = (stIndentPara s) - 1 }
90104
91105inTightList :: State WriterState a -> State WriterState a
92−inTightList f = do modify $ \s -> s { stTight = True }
93− r <- f
94− modify $ \s -> s { stTight = False }
95− return r
106+inTightList f = modify (\s -> s { stTight = True }) >> f >>= \r ->
107+ modify (\s -> s { stTight = False }) >> return r
96108
97109setInDefinitionList :: Bool -> State WriterState ()
98110setInDefinitionList b = modify $ \s -> s { stInDefinition = b }
@@ -106,6 +118,22 @@ inParagraphTagsWithStyle sty = inTags False "text:p" [("text:style-name", sty)]
106118inSpanTags :: String -> Doc -> Doc
107119inSpanTags s = inTags False "text:span" [("text:style-name",s)]
108120
121+withTextStyle :: TextStyle -> State WriterState a -> State WriterState a
122+withTextStyle s f = addTextStyleAttr (s,textStyleAttr s) >>
123+ f >>= \r -> rmTextStyleAttr >> return r
124+
125+inTextStyle :: Doc -> State WriterState Doc
126+inTextStyle d = do
127+ at <- gets stTextStyleAttr
128+ if at == []
129+ then return d
130+ else do
131+ tn <- (+) 1 . length <$> gets stTextStyles
132+ addTextStyle $ inTags False "style:style" [("style:name" , "T" ++ show tn)
133+ ,("style:family", "text" )]
134+ $ selfClosingTag "style:text-properties" (concatMap snd at)
135+ return $ inTags False "text:span" [("text:style-name","T" ++ show tn)] d
136+
109137inHeaderTags :: Int -> Doc -> Doc
110138inHeaderTags i = inTags False "text:h" [ ("text:style-name", "Heading_20_" ++ show i)
111139 , ("text:outline-level", show i)]
@@ -166,9 +194,10 @@ writeOpenDocument opts (Pandoc (Meta title authors date) blocks) =
166194 then inTagsIndented "office:body" $
167195 inTagsIndented "office:text" (meta $$ body)
168196 else body
197+ styles = stTableStyles s ++ stParaStyles s ++ stTextStyles s
169198 listStyle (n,l) = inTags True "text:list-style" [("style:name", "L" ++ show n)] (vcat l)
170199 listStyles = map listStyle (stListStyles s)
171− in render $ header $$ root (generateStyles (stTableStyles s ++ stParaStyles s ++ listStyles) $$ body' $$ text "")
200+ in render $ header $$ root (generateStyles (styles ++ listStyles) $$ body' $$ text "")
172201
173202withParagraphStyle :: WriterOptions -> String -> [Block] -> State WriterState Doc
174203withParagraphStyle o s (b:bs)
@@ -328,18 +357,18 @@ inlinesToOpenDocument o l = hcat <$> mapM (inlineToOpenDocument o) l
328357-- | Convert an inline element to OpenDocument.
329358inlineToOpenDocument :: WriterOptions -> Inline -> State WriterState Doc
330359inlineToOpenDocument o ils
331− | Ellipses <- ils = return $ text "…"
332− | EmDash <- ils = return $ text "—"
333− | EnDash <- ils = return $ text "–"
334− | Apostrophe <- ils = return $ text "’"
335− | Space <- ils = return $ char ' '
360+ | Ellipses <- ils = inTextStyle $ text "…"
361+ | EmDash <- ils = inTextStyle $ text "—"
362+ | EnDash <- ils = inTextStyle $ text "–"
363+ | Apostrophe <- ils = inTextStyle $ text "’"
364+ | Space <- ils = inTextStyle $ char ' '
336365 | LineBreak <- ils = return $ selfClosingTag "text:line-break" []
337− | Str s <- ils = return $ handleSpaces $ escapeStringForXML s
338− | Emph l <- ils = inSpanTags "Emphasis" <$> inlinesToOpenDocument o l
339− | Strong l <- ils = inSpanTags "Strong_20_Emphasis" <$> inlinesToOpenDocument o l
340− | Strikeout l <- ils = inSpanTags "Strikeout" <$> inlinesToOpenDocument o l
341− | Superscript l <- ils = inSpanTags "Superscript" <$> inlinesToOpenDocument o l
342− | Subscript l <- ils = inSpanTags "Subscript" <$> inlinesToOpenDocument o l
366+ | Str s <- ils = inTextStyle $ handleSpaces $ escapeStringForXML s
367+ | Emph l <- ils = withTextStyle Italic $ inlinesToOpenDocument o l
368+ | Strong l <- ils = withTextStyle Bold $ inlinesToOpenDocument o l
369+ | Strikeout l <- ils = withTextStyle Strike $ inlinesToOpenDocument o l
370+ | Superscript l <- ils = withTextStyle Sup $ inlinesToOpenDocument o l
371+ | Subscript l <- ils = withTextStyle Sub $ inlinesToOpenDocument o l
343372 | Quoted t l <- ils = inQuotes t <$> inlinesToOpenDocument o l
344373 | Code s <- ils = preformatted s
345374 | Math s <- ils = inlinesToOpenDocument o (readTeXMath s)
@@ -479,6 +508,21 @@ paraTableStyles t s (a:xs)
479508 [ ("fo:text-align", x)
480509 , ("style:justify-single-word", "false")]
481510
511+data TextStyle = Italic | Bold | Strike | Sub | Sup deriving ( Eq )
512+
513+textStyleAttr :: TextStyle -> [(String,String)]
514+textStyleAttr s
515+ | Italic <- s = [("fo:font-style" ,"italic" )
516+ ,("style:font-style-asian" ,"italic" )
517+ ,("style:font-style-complex" ,"italic" )]
518+ | Bold <- s = [("fo:font-weight" ,"bold" )
519+ ,("style:font-weight-asian" ,"bold" )
520+ ,("style:font-weight-complex" ,"bold" )]
521+ | Strike <- s = [("style:text-line-through-style", "solid" )]
522+ | Sub <- s = [("style:text-position" ,"sub 58%")]
523+ | Sup <- s = [("style:text-position" ,"sup 58%")]
524+ | otherwise = []
525+
482526openDocumentNameSpaces :: [(String, String)]
483527openDocumentNameSpaces =
484528 [ ("xmlns:office" , "urn:oasis:names:tc:opendocument:xmlns:office:1.0" )