diff options
| author | John MacFarlane <[email protected]> | 2023-08-04 11:45:59 -0700 |
|---|---|---|
| committer | John MacFarlane <[email protected]> | 2023-08-04 13:31:06 -0700 |
| commit | 5e1b9591e1999e25b0ef9dc3f642f5cdd3beed8d (patch) | |
| tree | dfc8325cc342460dca0ef8af08372002d4fa58ad /src/Text | |
| parent | 4670722dfaa91314686d21b4c57d35530aa8646b (diff) | |
Started implementing syntax highlighting for ODT.
Currently only colors are supported, not other text styles.
This change includes a new default opendocumnet template.
See #6710.
Diffstat (limited to 'src/Text')
| -rw-r--r-- | src/Text/Pandoc/Writers/OpenDocument.hs | 25 |
1 files changed, 24 insertions, 1 deletions
diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index 8b1090e9e..bad61a747 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -15,7 +15,7 @@ Conversion of 'Pandoc' documents to OpenDocument XML. -} module Text.Pandoc.Writers.OpenDocument ( writeOpenDocument ) where import Control.Arrow ((***), (>>>)) -import Control.Monad (unless, liftM) +import Control.Monad (unless, liftM, MonadPlus(mplus)) import Control.Monad.State.Strict ( StateT(..), modify, gets, lift ) import Data.Char (chr) import Data.Foldable (find) @@ -45,6 +45,7 @@ import Text.Pandoc.XML import Text.Printf (printf) import Text.Pandoc.Highlighting (highlight) import Skylighting +import qualified Data.Map as M -- | Auxiliary function to convert Plain block to Para. plainToPara :: Block -> Block @@ -267,9 +268,11 @@ writeOpenDocument opts (Pandoc meta blocks) = do [("style:name", "L" <> tshow n)] (vcat l) let listStyles = map listStyle (stListStyles s) let automaticStyles = vcat $ reverse $ styles ++ listStyles + let highlightingStyles = maybe mempty styleToOpenDocument (writerHighlightStyle opts) let context = defField "body" body . defField "toc" (writerTableOfContents opts) . defField "toc-depth" (tshow $ writerTOCDepth opts) + . defField "highlighting-styles" highlightingStyles . defField "automatic-styles" automaticStyles $ metadata return $ render colwidth $ @@ -917,3 +920,23 @@ withLangFromAttr (_,_,kvs) action = Left _ -> do report $ InvalidLang l action + +styleToOpenDocument :: Style -> Doc Text +styleToOpenDocument style = vcat (parStyle : map toStyle alltoktypes) + where alltoktypes = enumFromTo KeywordTok NormalTok + toStyle toktype = inTags True "style:style" [("style:name", tshow toktype), + ("style:family", "text")] $ + selfClosingTag "style:text-properties" + (tokColor toktype ++ tokBgColor toktype) + tokStyles = tokenStyles style + tokFeatures f toktype = maybe False f $ M.lookup toktype tokStyles + tokColor toktype = maybe [] (\c -> [("fo:color", T.pack (fromColor c))]) + $ (tokenColor =<< M.lookup toktype tokStyles) + `mplus` defaultColor style + tokBgColor toktype = maybe [] (\c -> [("fo:background-color", T.pack (fromColor c))]) + $ (tokenBackground =<< M.lookup toktype tokStyles) + `mplus` backgroundColor style + parStyle = inTags True "w:style" [("style:name", "SourceCode"), + ("style:family", "paragraph"), + ("style:class", "text")] mempty + |