OpenDocument writer: support nested inline styles.
git-svn-id: https://pandoc.googlecode.com/svn/trunk@1319 788f1e2b-df1e-0410-8736-df70ead52e1b
This commit is contained in:
fiddlosopher
parent
d5c73ac42a
commit
8f41289306
1 changed files with 67 additions and 23 deletions
|
|
@ -50,13 +50,15 @@ plainToPara x = x
|
|||
--
|
||||
|
||||
data WriterState =
|
||||
WriterState { stNotes :: [Doc]
|
||||
, stTableStyles :: [Doc]
|
||||
, stParaStyles :: [Doc]
|
||||
, stListStyles :: [(Int, [Doc])]
|
||||
, stIndentPara :: Int
|
||||
, stInDefinition :: Bool
|
||||
, stTight :: Bool
|
||||
WriterState { stNotes :: [Doc]
|
||||
, stTableStyles :: [Doc]
|
||||
, stParaStyles :: [Doc]
|
||||
, stListStyles :: [(Int, [Doc])]
|
||||
, stTextStyles :: [Doc]
|
||||
, stTextStyleAttr :: [(TextStyle,[(String,String)])]
|
||||
, stIndentPara :: Int
|
||||
, stInDefinition :: Bool
|
||||
, stTight :: Bool
|
||||
}
|
||||
|
||||
defaultWriterState :: WriterState
|
||||
|
|
@ -65,6 +67,8 @@ defaultWriterState =
|
|||
, stTableStyles = []
|
||||
, stParaStyles = []
|
||||
, stListStyles = []
|
||||
, stTextStyles = []
|
||||
, stTextStyleAttr = []
|
||||
, stIndentPara = 0
|
||||
, stInDefinition = False
|
||||
, stTight = False
|
||||
|
|
@ -82,6 +86,16 @@ addNote i = modify $ \s -> s { stNotes = i : stNotes s }
|
|||
addParaStyle :: Doc -> State WriterState ()
|
||||
addParaStyle i = modify $ \s -> s { stParaStyles = i : stParaStyles s }
|
||||
|
||||
addTextStyle :: Doc -> State WriterState ()
|
||||
addTextStyle i = modify $ \s -> s { stTextStyles = i : stTextStyles s }
|
||||
|
||||
addTextStyleAttr :: (TextStyle, [(String,String)]) -> State WriterState ()
|
||||
addTextStyleAttr i = modify $ \s -> s { stTextStyleAttr = i : stTextStyleAttr s }
|
||||
|
||||
rmTextStyleAttr :: State WriterState ()
|
||||
rmTextStyleAttr = modify $ \s -> s { stTextStyleAttr = rmHead (stTextStyleAttr s) }
|
||||
where rmHead l = if l /= [] then tail l else []
|
||||
|
||||
increaseIndent :: State WriterState ()
|
||||
increaseIndent = modify $ \s -> s { stIndentPara = 1 + stIndentPara s }
|
||||
|
||||
|
|
@ -89,10 +103,8 @@ resetIndent :: State WriterState ()
|
|||
resetIndent = modify $ \s -> s { stIndentPara = (stIndentPara s) - 1 }
|
||||
|
||||
inTightList :: State WriterState a -> State WriterState a
|
||||
inTightList f = do modify $ \s -> s { stTight = True }
|
||||
r <- f
|
||||
modify $ \s -> s { stTight = False }
|
||||
return r
|
||||
inTightList f = modify (\s -> s { stTight = True }) >> f >>= \r ->
|
||||
modify (\s -> s { stTight = False }) >> return r
|
||||
|
||||
setInDefinitionList :: Bool -> State WriterState ()
|
||||
setInDefinitionList b = modify $ \s -> s { stInDefinition = b }
|
||||
|
|
@ -106,6 +118,22 @@ inParagraphTagsWithStyle sty = inTags False "text:p" [("text:style-name", sty)]
|
|||
inSpanTags :: String -> Doc -> Doc
|
||||
inSpanTags s = inTags False "text:span" [("text:style-name",s)]
|
||||
|
||||
withTextStyle :: TextStyle -> State WriterState a -> State WriterState a
|
||||
withTextStyle s f = addTextStyleAttr (s,textStyleAttr s) >>
|
||||
f >>= \r -> rmTextStyleAttr >> return r
|
||||
|
||||
inTextStyle :: Doc -> State WriterState Doc
|
||||
inTextStyle d = do
|
||||
at <- gets stTextStyleAttr
|
||||
if at == []
|
||||
then return d
|
||||
else do
|
||||
tn <- (+) 1 . length <$> gets stTextStyles
|
||||
addTextStyle $ inTags False "style:style" [("style:name" , "T" ++ show tn)
|
||||
,("style:family", "text" )]
|
||||
$ selfClosingTag "style:text-properties" (concatMap snd at)
|
||||
return $ inTags False "text:span" [("text:style-name","T" ++ show tn)] d
|
||||
|
||||
inHeaderTags :: Int -> Doc -> Doc
|
||||
inHeaderTags i = inTags False "text:h" [ ("text:style-name", "Heading_20_" ++ show i)
|
||||
, ("text:outline-level", show i)]
|
||||
|
|
@ -166,9 +194,10 @@ writeOpenDocument opts (Pandoc (Meta title authors date) blocks) =
|
|||
then inTagsIndented "office:body" $
|
||||
inTagsIndented "office:text" (meta $$ body)
|
||||
else body
|
||||
styles = stTableStyles s ++ stParaStyles s ++ stTextStyles s
|
||||
listStyle (n,l) = inTags True "text:list-style" [("style:name", "L" ++ show n)] (vcat l)
|
||||
listStyles = map listStyle (stListStyles s)
|
||||
in render $ header $$ root (generateStyles (stTableStyles s ++ stParaStyles s ++ listStyles) $$ body' $$ text "")
|
||||
in render $ header $$ root (generateStyles (styles ++ listStyles) $$ body' $$ text "")
|
||||
|
||||
withParagraphStyle :: WriterOptions -> String -> [Block] -> State WriterState Doc
|
||||
withParagraphStyle o s (b:bs)
|
||||
|
|
@ -328,18 +357,18 @@ inlinesToOpenDocument o l = hcat <$> mapM (inlineToOpenDocument o) l
|
|||
-- | Convert an inline element to OpenDocument.
|
||||
inlineToOpenDocument :: WriterOptions -> Inline -> State WriterState Doc
|
||||
inlineToOpenDocument o ils
|
||||
| Ellipses <- ils = return $ text "…"
|
||||
| EmDash <- ils = return $ text "—"
|
||||
| EnDash <- ils = return $ text "–"
|
||||
| Apostrophe <- ils = return $ text "’"
|
||||
| Space <- ils = return $ char ' '
|
||||
| Ellipses <- ils = inTextStyle $ text "…"
|
||||
| EmDash <- ils = inTextStyle $ text "—"
|
||||
| EnDash <- ils = inTextStyle $ text "–"
|
||||
| Apostrophe <- ils = inTextStyle $ text "’"
|
||||
| Space <- ils = inTextStyle $ char ' '
|
||||
| LineBreak <- ils = return $ selfClosingTag "text:line-break" []
|
||||
| Str s <- ils = return $ handleSpaces $ escapeStringForXML s
|
||||
| Emph l <- ils = inSpanTags "Emphasis" <$> inlinesToOpenDocument o l
|
||||
| Strong l <- ils = inSpanTags "Strong_20_Emphasis" <$> inlinesToOpenDocument o l
|
||||
| Strikeout l <- ils = inSpanTags "Strikeout" <$> inlinesToOpenDocument o l
|
||||
| Superscript l <- ils = inSpanTags "Superscript" <$> inlinesToOpenDocument o l
|
||||
| Subscript l <- ils = inSpanTags "Subscript" <$> inlinesToOpenDocument o l
|
||||
| Str s <- ils = inTextStyle $ handleSpaces $ escapeStringForXML s
|
||||
| Emph l <- ils = withTextStyle Italic $ inlinesToOpenDocument o l
|
||||
| Strong l <- ils = withTextStyle Bold $ inlinesToOpenDocument o l
|
||||
| Strikeout l <- ils = withTextStyle Strike $ inlinesToOpenDocument o l
|
||||
| Superscript l <- ils = withTextStyle Sup $ inlinesToOpenDocument o l
|
||||
| Subscript l <- ils = withTextStyle Sub $ inlinesToOpenDocument o l
|
||||
| Quoted t l <- ils = inQuotes t <$> inlinesToOpenDocument o l
|
||||
| Code s <- ils = preformatted s
|
||||
| Math s <- ils = inlinesToOpenDocument o (readTeXMath s)
|
||||
|
|
@ -479,6 +508,21 @@ paraTableStyles t s (a:xs)
|
|||
[ ("fo:text-align", x)
|
||||
, ("style:justify-single-word", "false")]
|
||||
|
||||
data TextStyle = Italic | Bold | Strike | Sub | Sup deriving ( Eq )
|
||||
|
||||
textStyleAttr :: TextStyle -> [(String,String)]
|
||||
textStyleAttr s
|
||||
| Italic <- s = [("fo:font-style" ,"italic" )
|
||||
,("style:font-style-asian" ,"italic" )
|
||||
,("style:font-style-complex" ,"italic" )]
|
||||
| Bold <- s = [("fo:font-weight" ,"bold" )
|
||||
,("style:font-weight-asian" ,"bold" )
|
||||
,("style:font-weight-complex" ,"bold" )]
|
||||
| Strike <- s = [("style:text-line-through-style", "solid" )]
|
||||
| Sub <- s = [("style:text-position" ,"sub 58%")]
|
||||
| Sup <- s = [("style:text-position" ,"sup 58%")]
|
||||
| otherwise = []
|
||||
|
||||
openDocumentNameSpaces :: [(String, String)]
|
||||
openDocumentNameSpaces =
|
||||
[ ("xmlns:office" , "urn:oasis:names:tc:opendocument:xmlns:office:1.0" )
|
||||
|
|
|
|||
Loading…
Reference in a new issue