From d0a895acee371b13a9c31873c10dd124e04564d1 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Thu, 18 Jan 2018 12:34:19 -0500 Subject: Powerpoint writer: Implement syntax highlighting This also necessitated implementing colors and underlining, though there is currently no way to produce these from markdown. Note that background colors can't be implemented in PowerPoint, so highlighting styles that require these will be incomplete. --- src/Text/Pandoc/Writers/Powerpoint/Output.hs | 57 +++++++++++++--------- src/Text/Pandoc/Writers/Powerpoint/Presentation.hs | 49 ++++++++++++++++++- 2 files changed, 82 insertions(+), 24 deletions(-) (limited to 'src') diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs index f0485adcc..d30819d47 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs @@ -38,6 +38,7 @@ import Control.Monad.Except (throwError, catchError) import Control.Monad.Reader import Control.Monad.State import Codec.Archive.Zip +import Data.Char (toUpper) import Data.List (intercalate, stripPrefix, nub, union, isPrefixOf) import Data.Default import Text.Pandoc.Compat.Time (formatTime, defaultTimeLocale) @@ -62,6 +63,7 @@ import System.FilePath.Glob import Text.TeXMath import Text.Pandoc.Writers.Math (convertMath) import Text.Pandoc.Writers.Powerpoint.Presentation +import Skylighting (fromColor) -- This populates the global ids map with images already in the -- template, so the ids won't be used by images introduced by the @@ -703,26 +705,28 @@ paraElemToElement Break = return $ mknode "a:br" [] () paraElemToElement (Run rpr s) = do let sizeAttrs = case rPropForceSize rpr of Just n -> [("sz", (show $ n * 100))] - Nothing -> [] + Nothing -> if rPropCode rpr + -- hardcoded size for code for now + then [("sz", "1800")] + else [] attrs = sizeAttrs ++ - if rPropCode rpr - then [] - else (if rPropBold rpr then [("b", "1")] else []) ++ - (if rPropItalics rpr then [("i", "1")] else []) ++ - (case rStrikethrough rpr of - Just NoStrike -> [("strike", "noStrike")] - Just SingleStrike -> [("strike", "sngStrike")] - Just DoubleStrike -> [("strike", "dblStrike")] - Nothing -> []) ++ - (case rBaseline rpr of - Just n -> [("baseline", show n)] - Nothing -> []) ++ - (case rCap rpr of - Just NoCapitals -> [("cap", "none")] - Just SmallCapitals -> [("cap", "small")] - Just AllCapitals -> [("cap", "all")] - Nothing -> []) ++ - [] + (if rPropBold rpr then [("b", "1")] else []) ++ + (if rPropItalics rpr then [("i", "1")] else []) ++ + (if rPropUnderline rpr then [("u", "sng")] else []) ++ + (case rStrikethrough rpr of + Just NoStrike -> [("strike", "noStrike")] + Just SingleStrike -> [("strike", "sngStrike")] + Just DoubleStrike -> [("strike", "dblStrike")] + Nothing -> []) ++ + (case rBaseline rpr of + Just n -> [("baseline", show n)] + Nothing -> []) ++ + (case rCap rpr of + Just NoCapitals -> [("cap", "none")] + Just SmallCapitals -> [("cap", "small")] + Just AllCapitals -> [("cap", "all")] + Nothing -> []) ++ + [] linkProps <- case rLink rpr of Just link -> do idNum <- registerLink link @@ -743,10 +747,19 @@ paraElemToElement (Run rpr s) = do ] in [mknode "a:hlinkClick" linkAttrs ()] Nothing -> return [] - let propContents = if rPropCode rpr + let colorContents = case rSolidFill rpr of + Just color -> + case fromColor color of + '#':hx -> [mknode "a:solidFill" [] + [mknode "a:srgbClr" [("val", map toUpper hx)] ()] + ] + _ -> [] + Nothing -> [] + let codeContents = if rPropCode rpr then [mknode "a:latin" [("typeface", "Courier")] ()] - else linkProps - return $ mknode "a:r" [] [ mknode "a:rPr" attrs propContents + else [] + let propContents = linkProps ++ colorContents ++ codeContents + return $ mknode "a:r" [] [ mknode "a:rPr" attrs $ propContents , mknode "a:t" [] s ] paraElemToElement (MathElem mathType texStr) = do diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs index e1192745f..f5f7d850f 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs @@ -73,6 +73,10 @@ import Text.Pandoc.Writers.Shared (metaValueToInlines) import qualified Data.Map as M import qualified Data.Set as S import Data.Maybe (maybeToList) +import Text.Pandoc.Highlighting +import qualified Data.Text as T +import Control.Applicative ((<|>)) +import Skylighting data WriterEnv = WriterEnv { envMetadata :: Meta , envRunProps :: RunProps @@ -280,6 +284,10 @@ data RunProps = RunProps { rPropBold :: Bool , rPropCode :: Bool , rPropBlockQuote :: Bool , rPropForceSize :: Maybe Pixels + , rSolidFill :: Maybe Color + -- TODO: Make a full underline data type with + -- the different options. + , rPropUnderline :: Bool } deriving (Show, Eq) instance Default RunProps where @@ -292,6 +300,8 @@ instance Default RunProps where , rPropCode = False , rPropBlockQuote = False , rPropForceSize = Nothing + , rSolidFill = Nothing + , rPropUnderline = False } data PicProps = PicProps { picPropLink :: Maybe LinkTarget @@ -391,8 +401,17 @@ blockToParagraphs (LineBlock ilsList) = do return [Paragraph pProps parElems] -- TODO: work out the attributes blockToParagraphs (CodeBlock attr str) = - local (\r -> r{envParaProps = def{pPropMarginLeft = Just 100}}) $ - blockToParagraphs $ Para [Code attr str] + local (\r -> r{ envParaProps = def{pPropMarginLeft = Just 100} + , envRunProps = (envRunProps r){rPropCode = True}}) $ do + mbSty <- writerHighlightStyle <$> asks envOpts + synMap <- writerSyntaxMap <$> asks envOpts + case mbSty of + Just sty -> + case highlight synMap (formatSourceLines sty) attr str of + Right pElems -> do pProps <- asks envParaProps + return $ [Paragraph pProps pElems] + Left _ -> blockToParagraphs $ Para [Str str] + Nothing -> blockToParagraphs $ Para [Str str] -- We can't yet do incremental lists, but we should render a -- (BlockQuote List) as a list to maintain compatibility with other -- formats. @@ -878,3 +897,29 @@ documentToPresentation opts (Pandoc meta blks) = docProps = metaToDocProps meta in (Presentation docProps presSlides, msgs) + +-- -------------------------------------------------------------- + +applyTokStyToRunProps :: TokenStyle -> RunProps -> RunProps +applyTokStyToRunProps tokSty rProps = + rProps{ rSolidFill = tokenColor tokSty <|> rSolidFill rProps + , rPropBold = tokenBold tokSty || rPropBold rProps + , rPropItalics = tokenItalic tokSty || rPropItalics rProps + , rPropUnderline = tokenUnderline tokSty || rPropUnderline rProps + } + +formatToken :: Style -> Token -> ParaElem +formatToken sty (tokType, txt) = + let rProps = def{rPropCode = True, rSolidFill = defaultColor sty} + rProps' = case M.lookup tokType (tokenStyles sty) of + Just tokSty -> applyTokStyToRunProps tokSty rProps + Nothing -> rProps + in + Run rProps' $ T.unpack txt + +formatSourceLine :: Style -> FormatOptions -> SourceLine -> [ParaElem] +formatSourceLine sty _ srcLn = map (formatToken sty) srcLn + +formatSourceLines :: Style -> FormatOptions -> [SourceLine] -> [ParaElem] +formatSourceLines sty opts srcLns = intercalate [Break] $ + map (formatSourceLine sty opts) srcLns -- cgit v1.2.3