aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers/OpenDocument.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Writers/OpenDocument.hs')
-rw-r--r--src/Text/Pandoc/Writers/OpenDocument.hs626
1 files changed, 0 insertions, 626 deletions
diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs
deleted file mode 100644
index 851e18b8e..000000000
--- a/src/Text/Pandoc/Writers/OpenDocument.hs
+++ /dev/null
@@ -1,626 +0,0 @@
-{-# LANGUAGE PatternGuards, OverloadedStrings, FlexibleContexts #-}
-{-
-Copyright (C) 2008-2015 Andrea Rossato <andrea.rossato@ing.unitn.it>
- and John MacFarlane.
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
--}
-
-{- |
- Module : Text.Pandoc.Writers.OpenDocument
- Copyright : Copyright (C) 2008-2015 Andrea Rossato and John MacFarlane
- License : GNU GPL, version 2 or above
-
- Maintainer : Andrea Rossato <andrea.rossato@ing.unitn.it>
- Stability : alpha
- Portability : portable
-
-Conversion of 'Pandoc' documents to OpenDocument XML.
--}
-module Text.Pandoc.Writers.OpenDocument ( writeOpenDocument ) where
-import Text.Pandoc.Definition
-import Text.Pandoc.Options
-import Text.Pandoc.XML
-import Text.Pandoc.Shared (linesToPara)
-import Text.Pandoc.Templates (renderTemplate')
-import Text.Pandoc.Writers.Math
-import Text.Pandoc.Pretty
-import Text.Printf ( printf )
-import Control.Arrow ( (***), (>>>) )
-import Control.Monad.State hiding ( when )
-import Data.Char (chr)
-import qualified Data.Set as Set
-import qualified Data.Map as Map
-import Text.Pandoc.Writers.Shared
-import Data.List (sortBy)
-import Data.Ord (comparing)
-import Text.Pandoc.Class (PandocMonad, report)
-import Text.Pandoc.Logging
-
--- | Auxiliary function to convert Plain block to Para.
-plainToPara :: Block -> Block
-plainToPara (Plain x) = Para x
-plainToPara x = x
-
---
--- OpenDocument writer
---
-
-type OD m = StateT WriterState m
-
-data WriterState =
- WriterState { stNotes :: [Doc]
- , stTableStyles :: [Doc]
- , stParaStyles :: [Doc]
- , stListStyles :: [(Int, [Doc])]
- , stTextStyles :: Map.Map (Set.Set TextStyle) (String, Doc)
- , stTextStyleAttr :: Set.Set TextStyle
- , stIndentPara :: Int
- , stInDefinition :: Bool
- , stTight :: Bool
- , stFirstPara :: Bool
- , stImageId :: Int
- }
-
-defaultWriterState :: WriterState
-defaultWriterState =
- WriterState { stNotes = []
- , stTableStyles = []
- , stParaStyles = []
- , stListStyles = []
- , stTextStyles = Map.empty
- , stTextStyleAttr = Set.empty
- , stIndentPara = 0
- , stInDefinition = False
- , stTight = False
- , stFirstPara = False
- , stImageId = 1
- }
-
-when :: Bool -> Doc -> Doc
-when p a = if p then a else empty
-
-addTableStyle :: PandocMonad m => Doc -> OD m ()
-addTableStyle i = modify $ \s -> s { stTableStyles = i : stTableStyles s }
-
-addNote :: PandocMonad m => Doc -> OD m ()
-addNote i = modify $ \s -> s { stNotes = i : stNotes s }
-
-addParaStyle :: PandocMonad m => Doc -> OD m ()
-addParaStyle i = modify $ \s -> s { stParaStyles = i : stParaStyles s }
-
-addTextStyle :: PandocMonad m => Set.Set TextStyle -> (String, Doc) -> OD m ()
-addTextStyle attrs i = modify $ \s ->
- s { stTextStyles = Map.insert attrs i (stTextStyles s) }
-
-addTextStyleAttr :: PandocMonad m => TextStyle -> OD m ()
-addTextStyleAttr t = modify $ \s ->
- s { stTextStyleAttr = Set.insert t (stTextStyleAttr s) }
-
-increaseIndent :: PandocMonad m => OD m ()
-increaseIndent = modify $ \s -> s { stIndentPara = 1 + stIndentPara s }
-
-resetIndent :: PandocMonad m => OD m ()
-resetIndent = modify $ \s -> s { stIndentPara = (stIndentPara s) - 1 }
-
-inTightList :: PandocMonad m => OD m a -> OD m a
-inTightList f = modify (\s -> s { stTight = True }) >> f >>= \r ->
- modify (\s -> s { stTight = False }) >> return r
-
-setInDefinitionList :: PandocMonad m => Bool -> OD m ()
-setInDefinitionList b = modify $ \s -> s { stInDefinition = b }
-
-setFirstPara :: PandocMonad m => OD m ()
-setFirstPara = modify $ \s -> s { stFirstPara = True }
-
-inParagraphTags :: PandocMonad m => Doc -> OD m Doc
-inParagraphTags d | isEmpty d = return empty
-inParagraphTags d = do
- b <- gets stFirstPara
- a <- if b
- then do modify $ \st -> st { stFirstPara = False }
- return $ [("text:style-name", "First_20_paragraph")]
- else return [("text:style-name", "Text_20_body")]
- return $ inTags False "text:p" a d
-
-inParagraphTagsWithStyle :: String -> Doc -> Doc
-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 :: PandocMonad m => TextStyle -> OD m a -> OD m a
-withTextStyle s f = do
- oldTextStyleAttr <- gets stTextStyleAttr
- addTextStyleAttr s
- res <- f
- modify $ \st -> st{ stTextStyleAttr = oldTextStyleAttr }
- return res
-
-inTextStyle :: PandocMonad m => Doc -> OD m Doc
-inTextStyle d = do
- at <- gets stTextStyleAttr
- if Set.null at
- then return d
- else do
- styles <- gets stTextStyles
- case Map.lookup at styles of
- Just (styleName, _) -> return $
- inTags False "text:span" [("text:style-name",styleName)] d
- Nothing -> do
- let styleName = "T" ++ show (Map.size styles + 1)
- addTextStyle at (styleName,
- inTags False "style:style"
- [("style:name", styleName)
- ,("style:family", "text")]
- $ selfClosingTag "style:text-properties"
- (concatMap textStyleAttr (Set.toList at)))
- return $ inTags False
- "text:span" [("text:style-name",styleName)] d
-
-inHeaderTags :: PandocMonad m => Int -> Doc -> OD m Doc
-inHeaderTags i d =
- return $ inTags False "text:h" [ ("text:style-name", "Heading_20_" ++ show i)
- , ("text:outline-level", show i)] d
-
-inQuotes :: QuoteType -> Doc -> Doc
-inQuotes SingleQuote s = char '\8216' <> s <> char '\8217'
-inQuotes DoubleQuote s = char '\8220' <> s <> char '\8221'
-
-handleSpaces :: String -> Doc
-handleSpaces s
- | ( ' ':_) <- s = genTag s
- | ('\t':x) <- s = selfClosingTag "text:tab" [] <> rm x
- | otherwise = rm s
- where
- genTag = span (==' ') >>> tag . length *** rm >>> uncurry (<>)
- tag n = when (n /= 0) $ selfClosingTag "text:s" [("text:c", show n)]
- rm ( ' ':xs) = char ' ' <> genTag xs
- rm ('\t':xs) = selfClosingTag "text:tab" [] <> genTag xs
- rm ( x:xs) = char x <> rm xs
- rm [] = empty
-
--- | Convert Pandoc document to string in OpenDocument format.
-writeOpenDocument :: PandocMonad m => WriterOptions -> Pandoc -> m String
-writeOpenDocument opts (Pandoc meta blocks) = do
- let colwidth = if writerWrapText opts == WrapAuto
- then Just $ writerColumns opts
- else Nothing
- let render' = render colwidth
- ((body, metadata),s) <- flip runStateT
- defaultWriterState $ do
- m <- metaToJSON opts
- (fmap (render colwidth) . blocksToOpenDocument opts)
- (fmap (render colwidth) . inlinesToOpenDocument opts)
- meta
- b <- render' `fmap` blocksToOpenDocument opts blocks
- return (b, m)
- let styles = stTableStyles s ++ stParaStyles s ++
- map snd (reverse $ sortBy (comparing fst) $
- Map.elems (stTextStyles s))
- listStyle (n,l) = inTags True "text:list-style"
- [("style:name", "L" ++ show n)] (vcat l)
- let listStyles = map listStyle (stListStyles s)
- let automaticStyles = vcat $ reverse $ styles ++ listStyles
- let context = defField "body" body
- $ defField "automatic-styles" (render' automaticStyles)
- $ metadata
- return $ case writerTemplate opts of
- Nothing -> body
- Just tpl -> renderTemplate' tpl context
-
-withParagraphStyle :: PandocMonad m
- => WriterOptions -> String -> [Block] -> OD m Doc
-withParagraphStyle o s (b:bs)
- | Para l <- b = go =<< inParagraphTagsWithStyle s <$> inlinesToOpenDocument o l
- | otherwise = go =<< blockToOpenDocument o b
- where go i = (<>) i <$> withParagraphStyle o s bs
-withParagraphStyle _ _ [] = return empty
-
-inPreformattedTags :: PandocMonad m => String -> OD m Doc
-inPreformattedTags s = do
- n <- paraStyle [("style:parent-style-name","Preformatted_20_Text")]
- return . inParagraphTagsWithStyle ("P" ++ show n) . handleSpaces $ s
-
-orderedListToOpenDocument :: PandocMonad m
- => WriterOptions -> Int -> [[Block]] -> OD m Doc
-orderedListToOpenDocument o pn bs =
- vcat . map (inTagsIndented "text:list-item") <$>
- mapM (orderedItemToOpenDocument o pn . map plainToPara) bs
-
-orderedItemToOpenDocument :: PandocMonad m
- => WriterOptions -> Int -> [Block] -> OD m Doc
-orderedItemToOpenDocument o n (b:bs)
- | OrderedList a l <- b = newLevel a l
- | Para l <- b = go =<< inParagraphTagsWithStyle ("P" ++ show n) <$> inlinesToOpenDocument o l
- | otherwise = go =<< blockToOpenDocument o b
- where
- go i = ($$) i <$> orderedItemToOpenDocument o n bs
- newLevel a l = do
- nn <- length <$> gets stParaStyles
- ls <- head <$> gets stListStyles
- modify $ \s -> s { stListStyles = orderedListLevelStyle a ls : tail (stListStyles s) }
- inTagsIndented "text:list" <$> orderedListToOpenDocument o nn l
-orderedItemToOpenDocument _ _ [] = return empty
-
-isTightList :: [[Block]] -> Bool
-isTightList [] = False
-isTightList (b:_)
- | Plain {} : _ <- b = True
- | otherwise = False
-
-newOrderedListStyle :: PandocMonad m
- => Bool -> ListAttributes -> OD m (Int,Int)
-newOrderedListStyle b a = do
- ln <- (+) 1 . length <$> gets stListStyles
- let nbs = orderedListLevelStyle a (ln, [])
- pn <- if b then inTightList (paraListStyle ln) else paraListStyle ln
- modify $ \s -> s { stListStyles = nbs : stListStyles s }
- return (ln,pn)
-
-bulletListToOpenDocument :: PandocMonad m
- => WriterOptions -> [[Block]] -> OD m Doc
-bulletListToOpenDocument o b = do
- ln <- (+) 1 . length <$> gets stListStyles
- (pn,ns) <- if isTightList b then inTightList (bulletListStyle ln) else bulletListStyle ln
- modify $ \s -> s { stListStyles = ns : stListStyles s }
- is <- listItemsToOpenDocument ("P" ++ show pn) o b
- return $ inTags True "text:list" [("text:style-name", "L" ++ show ln)] is
-
-listItemsToOpenDocument :: PandocMonad m
- => String -> WriterOptions -> [[Block]] -> OD m Doc
-listItemsToOpenDocument s o is =
- vcat . map (inTagsIndented "text:list-item") <$> mapM (withParagraphStyle o s . map plainToPara) is
-
-deflistItemToOpenDocument :: PandocMonad m
- => WriterOptions -> ([Inline],[[Block]]) -> OD m Doc
-deflistItemToOpenDocument o (t,d) = do
- let ts = if isTightList d
- then "Definition_20_Term_20_Tight" else "Definition_20_Term"
- ds = if isTightList d
- then "Definition_20_Definition_20_Tight" else "Definition_20_Definition"
- t' <- withParagraphStyle o ts [Para t]
- d' <- liftM vcat $ mapM (withParagraphStyle o ds . (map plainToPara)) d
- return $ t' $$ d'
-
-inBlockQuote :: PandocMonad m
- => WriterOptions -> Int -> [Block] -> OD m Doc
-inBlockQuote o i (b:bs)
- | BlockQuote l <- b = do increaseIndent
- ni <- paraStyle
- [("style:parent-style-name","Quotations")]
- go =<< inBlockQuote o ni (map plainToPara l)
- | Para l <- b = do go =<< inParagraphTagsWithStyle ("P" ++ show i) <$> inlinesToOpenDocument o l
- | otherwise = do go =<< blockToOpenDocument o b
- where go block = ($$) block <$> inBlockQuote o i bs
-inBlockQuote _ _ [] = resetIndent >> return empty
-
--- | Convert a list of Pandoc blocks to OpenDocument.
-blocksToOpenDocument :: PandocMonad m => WriterOptions -> [Block] -> OD m Doc
-blocksToOpenDocument o b = vcat <$> mapM (blockToOpenDocument o) b
-
--- | Convert a Pandoc block element to OpenDocument.
-blockToOpenDocument :: PandocMonad m => WriterOptions -> Block -> OD m Doc
-blockToOpenDocument o bs
- | Plain b <- bs = if null b
- then return empty
- else inParagraphTags =<< inlinesToOpenDocument o b
- | Para [Image attr c (s,'f':'i':'g':':':t)] <- bs
- = figure attr c s t
- | Para b <- bs = if null b
- then return empty
- else inParagraphTags =<< inlinesToOpenDocument o b
- | LineBlock b <- bs = blockToOpenDocument o $ linesToPara b
- | Div _ xs <- bs = blocksToOpenDocument o xs
- | Header i _ b <- bs = setFirstPara >>
- (inHeaderTags i =<< inlinesToOpenDocument o b)
- | BlockQuote b <- bs = setFirstPara >> mkBlockQuote b
- | DefinitionList b <- bs = setFirstPara >> defList b
- | BulletList b <- bs = setFirstPara >> bulletListToOpenDocument o b
- | OrderedList a b <- bs = setFirstPara >> orderedList a b
- | CodeBlock _ s <- bs = setFirstPara >> preformatted s
- | Table c a w h r <- bs = setFirstPara >> table c a w h r
- | HorizontalRule <- bs = setFirstPara >> return (selfClosingTag "text:p"
- [ ("text:style-name", "Horizontal_20_Line") ])
- | RawBlock f s <- bs = if f == Format "opendocument"
- then return $ text s
- else do
- report $ BlockNotRendered bs
- return empty
- | Null <- bs = return empty
- | otherwise = return empty
- where
- defList b = do setInDefinitionList True
- r <- vcat <$> mapM (deflistItemToOpenDocument o) b
- setInDefinitionList False
- return r
- preformatted s = (flush . vcat) <$> mapM (inPreformattedTags . escapeStringForXML) (lines s)
- mkBlockQuote b = do increaseIndent
- i <- paraStyle
- [("style:parent-style-name","Quotations")]
- inBlockQuote o i (map plainToPara b)
- orderedList a b = do (ln,pn) <- newOrderedListStyle (isTightList b) a
- inTags True "text:list" [ ("text:style-name", "L" ++ show ln)]
- <$> orderedListToOpenDocument o pn b
- table c a w h r = do
- tn <- length <$> gets stTableStyles
- pn <- length <$> gets stParaStyles
- let genIds = map chr [65..]
- name = "Table" ++ show (tn + 1)
- columnIds = zip genIds w
- mkColumn n = selfClosingTag "table:table-column" [("table:style-name", name ++ "." ++ [fst n])]
- columns = map mkColumn columnIds
- paraHStyles = paraTableStyles "Heading" pn a
- paraStyles = paraTableStyles "Contents" (pn + length (newPara paraHStyles)) a
- newPara = map snd . filter (not . isEmpty . snd)
- addTableStyle $ tableStyle tn columnIds
- mapM_ addParaStyle . newPara $ paraHStyles ++ paraStyles
- captionDoc <- if null c
- then return empty
- else withParagraphStyle o "Table" [Para c]
- th <- if all null h
- then return empty
- else colHeadsToOpenDocument o name (map fst paraHStyles) h
- tr <- mapM (tableRowToOpenDocument o name (map fst paraStyles)) r
- return $ inTags True "table:table" [ ("table:name" , name)
- , ("table:style-name", name)
- ] (vcat columns $$ th $$ vcat tr) $$ captionDoc
- figure attr caption source title | null caption =
- withParagraphStyle o "Figure" [Para [Image attr caption (source,title)]]
- | otherwise = do
- imageDoc <- withParagraphStyle o "FigureWithCaption" [Para [Image attr caption (source,title)]]
- captionDoc <- withParagraphStyle o "FigureCaption" [Para caption]
- return $ imageDoc $$ captionDoc
-
-colHeadsToOpenDocument :: PandocMonad m
- => WriterOptions -> String -> [String] -> [[Block]]
- -> OD m Doc
-colHeadsToOpenDocument o tn ns hs =
- inTagsIndented "table:table-header-rows" . inTagsIndented "table:table-row" . vcat <$>
- mapM (tableItemToOpenDocument o tn) (zip ns hs)
-
-tableRowToOpenDocument :: PandocMonad m
- => WriterOptions -> String -> [String] -> [[Block]]
- -> OD m Doc
-tableRowToOpenDocument o tn ns cs =
- inTagsIndented "table:table-row" . vcat <$>
- mapM (tableItemToOpenDocument o tn) (zip ns cs)
-
-tableItemToOpenDocument :: PandocMonad m
- => WriterOptions -> String -> (String,[Block])
- -> OD m Doc
-tableItemToOpenDocument o tn (n,i) =
- let a = [ ("table:style-name" , tn ++ ".A1" )
- , ("office:value-type", "string" )
- ]
- in inTags True "table:table-cell" a <$>
- withParagraphStyle o n (map plainToPara i)
-
--- | Convert a list of inline elements to OpenDocument.
-inlinesToOpenDocument :: PandocMonad m => WriterOptions -> [Inline] -> OD m Doc
-inlinesToOpenDocument o l = hcat <$> toChunks o l
-
-toChunks :: PandocMonad m => WriterOptions -> [Inline] -> OD m [Doc]
-toChunks _ [] = return []
-toChunks o (x : xs)
- | isChunkable x = do
- contents <- (inTextStyle . hcat) =<<
- mapM (inlineToOpenDocument o) (x:ys)
- rest <- toChunks o zs
- return (contents : rest)
- | otherwise = do
- contents <- inlineToOpenDocument o x
- rest <- toChunks o xs
- return (contents : rest)
- where (ys, zs) = span isChunkable xs
-
-isChunkable :: Inline -> Bool
-isChunkable (Str _) = True
-isChunkable Space = True
-isChunkable SoftBreak = True
-isChunkable _ = False
-
--- | Convert an inline element to OpenDocument.
-inlineToOpenDocument :: PandocMonad m => WriterOptions -> Inline -> OD m Doc
-inlineToOpenDocument o ils
- = case ils of
- Space -> return space
- SoftBreak
- | writerWrapText o == WrapPreserve
- -> return $ preformatted "\n"
- | otherwise -> return $ space
- Span _ xs -> inlinesToOpenDocument o xs
- LineBreak -> return $ selfClosingTag "text:line-break" []
- Str s -> return $ handleSpaces $ escapeStringForXML s
- Emph l -> withTextStyle Italic $ inlinesToOpenDocument o l
- Strong l -> withTextStyle Bold $ inlinesToOpenDocument o l
- Strikeout l -> withTextStyle Strike $ inlinesToOpenDocument o l
- Superscript l -> withTextStyle Sup $ inlinesToOpenDocument o l
- Subscript l -> withTextStyle Sub $ inlinesToOpenDocument o l
- SmallCaps l -> withTextStyle SmallC $ inlinesToOpenDocument o l
- Quoted t l -> inQuotes t <$> inlinesToOpenDocument o l
- Code _ s -> inlinedCode $ preformatted s
- Math t s -> lift (texMathToInlines t s) >>=
- inlinesToOpenDocument o
- Cite _ l -> inlinesToOpenDocument o l
- RawInline f s -> if f == Format "opendocument"
- then return $ text s
- else do
- report $ InlineNotRendered ils
- return empty
- Link _ l (s,t) -> mkLink s t <$> inlinesToOpenDocument o l
- Image attr _ (s,t) -> mkImg attr s t
- Note l -> mkNote l
- where
- preformatted s = handleSpaces $ escapeStringForXML s
- inlinedCode s = return $ inTags False "text:span" [("text:style-name", "Source_Text")] s
- mkLink s t = inTags False "text:a" [ ("xlink:type" , "simple")
- , ("xlink:href" , s )
- , ("office:name", t )
- ] . inSpanTags "Definition"
- mkImg (_, _, kvs) s _ = do
- id' <- gets stImageId
- modify (\st -> st{ stImageId = id' + 1 })
- let getDims [] = []
- getDims (("width", w) :xs) = ("svg:width", w) : getDims xs
- getDims (("height", h):xs) = ("svg:height", h) : getDims xs
- getDims (x@("style:rel-width", _) :xs) = x : getDims xs
- getDims (x@("style:rel-height", _):xs) = x : getDims xs
- getDims (_:xs) = getDims xs
- return $ inTags False "draw:frame"
- (("draw:name", "img" ++ show id') : getDims kvs) $
- selfClosingTag "draw:image" [ ("xlink:href" , s )
- , ("xlink:type" , "simple")
- , ("xlink:show" , "embed" )
- , ("xlink:actuate", "onLoad")]
- mkNote l = do
- n <- length <$> gets stNotes
- let footNote t = inTags False "text:note"
- [ ("text:id" , "ftn" ++ show n)
- , ("text:note-class", "footnote" )] $
- inTagsSimple "text:note-citation" (text . show $ n + 1) <>
- inTagsSimple "text:note-body" t
- nn <- footNote <$> withParagraphStyle o "Footnote" l
- addNote nn
- return nn
-
-bulletListStyle :: PandocMonad m => Int -> OD m (Int,(Int,[Doc]))
-bulletListStyle l = do
- let doStyles i = inTags True "text:list-level-style-bullet"
- [ ("text:level" , show (i + 1) )
- , ("text:style-name" , "Bullet_20_Symbols")
- , ("style:num-suffix", "." )
- , ("text:bullet-char", [bulletList !! i] )
- ] (listLevelStyle (1 + i))
- bulletList = map chr $ cycle [8226,8227,8259]
- listElStyle = map doStyles [0..9]
- pn <- paraListStyle l
- return (pn, (l, listElStyle))
-
-orderedListLevelStyle :: ListAttributes -> (Int, [Doc]) -> (Int,[Doc])
-orderedListLevelStyle (s,n, d) (l,ls) =
- let suffix = case d of
- OneParen -> [("style:num-suffix", ")")]
- TwoParens -> [("style:num-prefix", "(")
- ,("style:num-suffix", ")")]
- _ -> [("style:num-suffix", ".")]
- format = case n of
- UpperAlpha -> "A"
- LowerAlpha -> "a"
- UpperRoman -> "I"
- LowerRoman -> "i"
- _ -> "1"
- listStyle = inTags True "text:list-level-style-number"
- ([ ("text:level" , show $ 1 + length ls )
- , ("text:style-name" , "Numbering_20_Symbols")
- , ("style:num-format", format )
- , ("text:start-value", show s )
- ] ++ suffix) (listLevelStyle (1 + length ls))
- in (l, ls ++ [listStyle])
-
-listLevelStyle :: Int -> Doc
-listLevelStyle i =
- let indent = show (0.25 * fromIntegral i :: Double) in
- selfClosingTag "style:list-level-properties"
- [ ("text:space-before" , indent ++ "in")
- , ("text:min-label-width", "0.25in")]
-
-tableStyle :: Int -> [(Char,Double)] -> Doc
-tableStyle num wcs =
- let tableId = "Table" ++ show (num + 1)
- table = inTags True "style:style"
- [("style:name", tableId)
- ,("style:family", "table")] $
- selfClosingTag "style:table-properties"
- [("table:align" , "center")]
- colStyle (c,0) = selfClosingTag "style:style"
- [ ("style:name" , tableId ++ "." ++ [c])
- , ("style:family", "table-column" )]
- colStyle (c,w) = inTags True "style:style"
- [ ("style:name" , tableId ++ "." ++ [c])
- , ("style:family", "table-column" )] $
- selfClosingTag "style:table-column-properties"
- [("style:rel-column-width", printf "%d*" $ (floor $ w * 65535 :: Integer))]
- cellStyle = inTags True "style:style"
- [ ("style:name" , tableId ++ ".A1")
- , ("style:family", "table-cell" )] $
- selfClosingTag "style:table-cell-properties"
- [ ("fo:border", "none")]
- columnStyles = map colStyle wcs
- in table $$ vcat columnStyles $$ cellStyle
-
-paraStyle :: PandocMonad m => [(String,String)] -> OD m Int
-paraStyle attrs = do
- pn <- (+) 1 . length <$> gets stParaStyles
- i <- (*) (0.5 :: Double) . fromIntegral <$> gets stIndentPara
- b <- gets stInDefinition
- t <- gets stTight
- let styleAttr = [ ("style:name" , "P" ++ show pn)
- , ("style:family" , "paragraph" )]
- indentVal = flip (++) "in" . show $ if b then (max 0.5 i) else i
- tight = if t then [ ("fo:margin-top" , "0in" )
- , ("fo:margin-bottom" , "0in" )]
- else []
- indent = if (i /= 0 || b)
- then [ ("fo:margin-left" , indentVal)
- , ("fo:margin-right" , "0in" )
- , ("fo:text-indent" , "0in" )
- , ("style:auto-text-indent" , "false" )]
- else []
- attributes = indent ++ tight
- paraProps = when (not $ null attributes) $
- selfClosingTag "style:paragraph-properties" attributes
- addParaStyle $ inTags True "style:style" (styleAttr ++ attrs) paraProps
- return pn
-
-paraListStyle :: PandocMonad m => Int -> OD m Int
-paraListStyle l = paraStyle
- [("style:parent-style-name","Text_20_body")
- ,("style:list-style-name", "L" ++ show l )]
-
-paraTableStyles :: String -> Int -> [Alignment] -> [(String, Doc)]
-paraTableStyles _ _ [] = []
-paraTableStyles t s (a:xs)
- | AlignRight <- a = ( pName s, res s "end" ) : paraTableStyles t (s + 1) xs
- | AlignCenter <- a = ( pName s, res s "center") : paraTableStyles t (s + 1) xs
- | otherwise = ("Table_20_" ++ t, empty ) : paraTableStyles t s xs
- where pName sn = "P" ++ show (sn + 1)
- res sn x = inTags True "style:style"
- [ ("style:name" , pName sn )
- , ("style:family" , "paragraph" )
- , ("style:parent-style-name", "Table_20_" ++ t)] $
- selfClosingTag "style:paragraph-properties"
- [ ("fo:text-align", x)
- , ("style:justify-single-word", "false")]
-
-data TextStyle = Italic | Bold | Strike | Sub | Sup | SmallC | Pre
- deriving ( Eq,Ord )
-
-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" ,"super 58%" )]
- | SmallC <- s = [("fo:font-variant" ,"small-caps")]
- | Pre <- s = [("style:font-name" ,"Courier New")
- ,("style:font-name-asian" ,"Courier New")
- ,("style:font-name-complex" ,"Courier New")]
- | otherwise = []