git.iko.soy/typeable/pandoc
on master help sign in
OpenDocument writer: support nested inline styles.
8f41289fiddlosopher
Text/Pandoc/Writers/OpenDocument.hs+67−23
compare with master
unifiedsplit
@@ -50,13 +50,15 @@ plainToPara x = x
50--
50--
51
51
52data WriterState =
52data WriterState =
53− WriterState { stNotes :: [Doc]
53+ WriterState { stNotes :: [Doc]
54− , stTableStyles :: [Doc]
54+ , stTableStyles :: [Doc]
55− , stParaStyles :: [Doc]
55+ , stParaStyles :: [Doc]
56− , stListStyles :: [(Int, [Doc])]
56+ , stListStyles :: [(Int, [Doc])]
57+ , stTextStyles :: [Doc]
58+ , stTextStyleAttr :: [(TextStyle,[(String,String)])]
57− , stIndentPara :: Int
59+ , stIndentPara :: Int
58− , stInDefinition :: Bool
60+ , stInDefinition :: Bool
59− , stTight :: Bool
61+ , stTight :: Bool
60 }
62 }
61
63
62defaultWriterState :: WriterState
64defaultWriterState :: WriterState
@@ -65,6 +67,8 @@ defaultWriterState =
65 , stTableStyles = []
67 , stTableStyles = []
66 , stParaStyles = []
68 , stParaStyles = []
67 , stListStyles = []
69 , stListStyles = []
70+ , stTextStyles = []
71+ , stTextStyleAttr = []
68 , stIndentPara = 0
72 , stIndentPara = 0
69 , stInDefinition = False
73 , stInDefinition = False
70 , stTight = False
74 , stTight = False
@@ -82,6 +86,16 @@ addNote i = modify $ \s -> s { stNotes = i : stNotes s }
82addParaStyle :: Doc -> State WriterState ()
86addParaStyle :: Doc -> State WriterState ()
83addParaStyle i = modify $ \s -> s { stParaStyles = i : stParaStyles s }
87addParaStyle i = modify $ \s -> s { stParaStyles = i : stParaStyles s }
84
88
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+
85increaseIndent :: State WriterState ()
99increaseIndent :: State WriterState ()
86increaseIndent = modify $ \s -> s { stIndentPara = 1 + stIndentPara s }
100increaseIndent = modify $ \s -> s { stIndentPara = 1 + stIndentPara s }
87
101
@@ -89,10 +103,8 @@ resetIndent :: State WriterState ()
89resetIndent = modify $ \s -> s { stIndentPara = (stIndentPara s) - 1 }
103resetIndent = modify $ \s -> s { stIndentPara = (stIndentPara s) - 1 }
90
104
91inTightList :: State WriterState a -> State WriterState a
105inTightList :: State WriterState a -> State WriterState a
92−inTightList f = do modify $ \s -> s { stTight = True }
106+inTightList f = modify (\s -> s { stTight = True }) >> f >>= \r ->
93− r <- f
94− modify $ \s -> s { stTight = False }
107+ modify (\s -> s { stTight = False }) >> return r
95− return r
96
108
97setInDefinitionList :: Bool -> State WriterState ()
109setInDefinitionList :: Bool -> State WriterState ()
98setInDefinitionList b = modify $ \s -> s { stInDefinition = b }
110setInDefinitionList b = modify $ \s -> s { stInDefinition = b }
@@ -106,6 +118,22 @@ inParagraphTagsWithStyle sty = inTags False "text:p" [("text:style-name", sty)]
106inSpanTags :: String -> Doc -> Doc
118inSpanTags :: String -> Doc -> Doc
107inSpanTags s = inTags False "text:span" [("text:style-name",s)]
119inSpanTags s = inTags False "text:span" [("text:style-name",s)]
108
120
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+
109inHeaderTags :: Int -> Doc -> Doc
137inHeaderTags :: Int -> Doc -> Doc
110inHeaderTags i = inTags False "text:h" [ ("text:style-name", "Heading_20_" ++ show i)
138inHeaderTags i = inTags False "text:h" [ ("text:style-name", "Heading_20_" ++ show i)
111 , ("text:outline-level", show i)]
139 , ("text:outline-level", show i)]
@@ -166,9 +194,10 @@ writeOpenDocument opts (Pandoc (Meta title authors date) blocks) =
166 then inTagsIndented "office:body" $
194 then inTagsIndented "office:body" $
167 inTagsIndented "office:text" (meta $$ body)
195 inTagsIndented "office:text" (meta $$ body)
168 else body
196 else body
197+ styles = stTableStyles s ++ stParaStyles s ++ stTextStyles s
169 listStyle (n,l) = inTags True "text:list-style" [("style:name", "L" ++ show n)] (vcat l)
198 listStyle (n,l) = inTags True "text:list-style" [("style:name", "L" ++ show n)] (vcat l)
170 listStyles = map listStyle (stListStyles s)
199 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 "")
172
201
173withParagraphStyle :: WriterOptions -> String -> [Block] -> State WriterState Doc
202withParagraphStyle :: WriterOptions -> String -> [Block] -> State WriterState Doc
174withParagraphStyle o s (b:bs)
203withParagraphStyle o s (b:bs)
@@ -328,18 +357,18 @@ inlinesToOpenDocument o l = hcat <$> mapM (inlineToOpenDocument o) l
328-- | Convert an inline element to OpenDocument.
357-- | Convert an inline element to OpenDocument.
329inlineToOpenDocument :: WriterOptions -> Inline -> State WriterState Doc
358inlineToOpenDocument :: WriterOptions -> Inline -> State WriterState Doc
330inlineToOpenDocument o ils
359inlineToOpenDocument o ils
331− | Ellipses <- ils = return $ text "&#8230;"
360+ | Ellipses <- ils = inTextStyle $ text "&#8230;"
332− | EmDash <- ils = return $ text "&#8212;"
361+ | EmDash <- ils = inTextStyle $ text "&#8212;"
333− | EnDash <- ils = return $ text "&#8211;"
362+ | EnDash <- ils = inTextStyle $ text "&#8211;"
334− | Apostrophe <- ils = return $ text "&#8217;"
363+ | Apostrophe <- ils = inTextStyle $ text "&#8217;"
335− | Space <- ils = return $ char ' '
364+ | Space <- ils = inTextStyle $ char ' '
336 | LineBreak <- ils = return $ selfClosingTag "text:line-break" []
365 | LineBreak <- ils = return $ selfClosingTag "text:line-break" []
337− | Str s <- ils = return $ handleSpaces $ escapeStringForXML s
366+ | Str s <- ils = inTextStyle $ handleSpaces $ escapeStringForXML s
338− | Emph l <- ils = inSpanTags "Emphasis" <$> inlinesToOpenDocument o l
367+ | Emph l <- ils = withTextStyle Italic $ inlinesToOpenDocument o l
339− | Strong l <- ils = inSpanTags "Strong_20_Emphasis" <$> inlinesToOpenDocument o l
368+ | Strong l <- ils = withTextStyle Bold $ inlinesToOpenDocument o l
340− | Strikeout l <- ils = inSpanTags "Strikeout" <$> inlinesToOpenDocument o l
369+ | Strikeout l <- ils = withTextStyle Strike $ inlinesToOpenDocument o l
341− | Superscript l <- ils = inSpanTags "Superscript" <$> inlinesToOpenDocument o l
370+ | Superscript l <- ils = withTextStyle Sup $ inlinesToOpenDocument o l
342− | Subscript l <- ils = inSpanTags "Subscript" <$> inlinesToOpenDocument o l
371+ | Subscript l <- ils = withTextStyle Sub $ inlinesToOpenDocument o l
343 | Quoted t l <- ils = inQuotes t <$> inlinesToOpenDocument o l
372 | Quoted t l <- ils = inQuotes t <$> inlinesToOpenDocument o l
344 | Code s <- ils = preformatted s
373 | Code s <- ils = preformatted s
345 | Math s <- ils = inlinesToOpenDocument o (readTeXMath s)
374 | Math s <- ils = inlinesToOpenDocument o (readTeXMath s)
@@ -479,6 +508,21 @@ paraTableStyles t s (a:xs)
479 [ ("fo:text-align", x)
508 [ ("fo:text-align", x)
480 , ("style:justify-single-word", "false")]
509 , ("style:justify-single-word", "false")]
481
510
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+
482openDocumentNameSpaces :: [(String, String)]
526openDocumentNameSpaces :: [(String, String)]
483openDocumentNameSpaces =
527openDocumentNameSpaces =
484 [ ("xmlns:office" , "urn:oasis:names:tc:opendocument:xmlns:office:1.0" )
528 [ ("xmlns:office" , "urn:oasis:names:tc:opendocument:xmlns:office:1.0" )