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.

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
+