git.iko.soy/typeable/pandoc
on master help sign in
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.

commitd0a895acee371b13a9c31873c10dd124e04564d1 authorJesse Rosenthal <jrosenthal@jhu.edu> dateThu 18 Jan 2018, 12:34 (9 years ago) parent63b10cf
3 files changed+87−29
compare with master
unifiedsplit
MANUAL.txt+5−5 src/Text/Pandoc/Writers/Powerpoint/Output.hs+35−22 src/Text/Pandoc/Writers/Powerpoint/Presentation.hs+47−2
MANUAL.txt+5−5
@@ -2265,11 +2265,11 @@ this syntax:
22652265Here `mycode` is an identifier, `haskell` and `numberLines` are classes, and
22662266`startFrom` is an attribute with value `100`. Some output formats can use this
22672267information to do syntax highlighting. Currently, the only output formats
2268−that uses this information are HTML, LaTeX, Docx, and Ms. If highlighting
2269−is supported for your output format and language, then the code block above
2270−will appear highlighted, with numbered lines. (To see which languages are
2271−supported, type `pandoc --list-highlight-languages`.) Otherwise, the code
2272−block above will appear as follows:
2268+that uses this information are HTML, LaTeX, Docx, Ms, and PowerPoint. If
2269+highlighting is supported for your output format and language, then the code
2270+block above will appear highlighted, with numbered lines. (To see which
2271+languages are supported, type `pandoc --list-highlight-languages`.) Otherwise,
2272+the code block above will appear as follows:
22732273
22742274 <pre id="mycode" class="haskell numberLines" startFrom="100">
22752275 <code>
src/Text/Pandoc/Writers/Powerpoint/Output.hs+35−22
@@ -38,6 +38,7 @@ import Control.Monad.Except (throwError, catchError)
3838import Control.Monad.Reader
3939import Control.Monad.State
4040import Codec.Archive.Zip
41+import Data.Char (toUpper)
4142import Data.List (intercalate, stripPrefix, nub, union, isPrefixOf)
4243import Data.Default
4344import Text.Pandoc.Compat.Time (formatTime, defaultTimeLocale)
@@ -62,6 +63,7 @@ import System.FilePath.Glob
6263import Text.TeXMath
6364import Text.Pandoc.Writers.Math (convertMath)
6465import Text.Pandoc.Writers.Powerpoint.Presentation
66+import Skylighting (fromColor)
6567
6668-- This populates the global ids map with images already in the
6769-- template, so the ids won't be used by images introduced by the
@@ -703,26 +705,28 @@ paraElemToElement Break = return $ mknode "a:br" [] ()
703705paraElemToElement (Run rpr s) = do
704706 let sizeAttrs = case rPropForceSize rpr of
705707 Just n -> [("sz", (show $ n * 100))]
706− Nothing -> []
708+ Nothing -> if rPropCode rpr
709+ -- hardcoded size for code for now
710+ then [("sz", "1800")]
711+ else []
707712 attrs = sizeAttrs ++
708− if rPropCode rpr
709− then []
710− else (if rPropBold rpr then [("b", "1")] else []) ++
711− (if rPropItalics rpr then [("i", "1")] else []) ++
712− (case rStrikethrough rpr of
713− Just NoStrike -> [("strike", "noStrike")]
714− Just SingleStrike -> [("strike", "sngStrike")]
715− Just DoubleStrike -> [("strike", "dblStrike")]
716− Nothing -> []) ++
717− (case rBaseline rpr of
718− Just n -> [("baseline", show n)]
719− Nothing -> []) ++
720− (case rCap rpr of
721− Just NoCapitals -> [("cap", "none")]
722− Just SmallCapitals -> [("cap", "small")]
723− Just AllCapitals -> [("cap", "all")]
724− Nothing -> []) ++
725− []
713+ (if rPropBold rpr then [("b", "1")] else []) ++
714+ (if rPropItalics rpr then [("i", "1")] else []) ++
715+ (if rPropUnderline rpr then [("u", "sng")] else []) ++
716+ (case rStrikethrough rpr of
717+ Just NoStrike -> [("strike", "noStrike")]
718+ Just SingleStrike -> [("strike", "sngStrike")]
719+ Just DoubleStrike -> [("strike", "dblStrike")]
720+ Nothing -> []) ++
721+ (case rBaseline rpr of
722+ Just n -> [("baseline", show n)]
723+ Nothing -> []) ++
724+ (case rCap rpr of
725+ Just NoCapitals -> [("cap", "none")]
726+ Just SmallCapitals -> [("cap", "small")]
727+ Just AllCapitals -> [("cap", "all")]
728+ Nothing -> []) ++
729+ []
726730 linkProps <- case rLink rpr of
727731 Just link -> do
728732 idNum <- registerLink link
@@ -743,10 +747,19 @@ paraElemToElement (Run rpr s) = do
743747 ]
744748 in [mknode "a:hlinkClick" linkAttrs ()]
745749 Nothing -> return []
746− let propContents = if rPropCode rpr
750+ let colorContents = case rSolidFill rpr of
751+ Just color ->
752+ case fromColor color of
753+ '#':hx -> [mknode "a:solidFill" []
754+ [mknode "a:srgbClr" [("val", map toUpper hx)] ()]
755+ ]
756+ _ -> []
757+ Nothing -> []
758+ let codeContents = if rPropCode rpr
747759 then [mknode "a:latin" [("typeface", "Courier")] ()]
748− else linkProps
749− return $ mknode "a:r" [] [ mknode "a:rPr" attrs propContents
760+ else []
761+ let propContents = linkProps ++ colorContents ++ codeContents
762+ return $ mknode "a:r" [] [ mknode "a:rPr" attrs $ propContents
750763 , mknode "a:t" [] s
751764 ]
752765paraElemToElement (MathElem mathType texStr) = do
src/Text/Pandoc/Writers/Powerpoint/Presentation.hs+47−2
@@ -73,6 +73,10 @@ import Text.Pandoc.Writers.Shared (metaValueToInlines)
7373import qualified Data.Map as M
7474import qualified Data.Set as S
7575import Data.Maybe (maybeToList)
76+import Text.Pandoc.Highlighting
77+import qualified Data.Text as T
78+import Control.Applicative ((<|>))
79+import Skylighting
7680
7781data WriterEnv = WriterEnv { envMetadata :: Meta
7882 , envRunProps :: RunProps
@@ -280,6 +284,10 @@ data RunProps = RunProps { rPropBold :: Bool
280284 , rPropCode :: Bool
281285 , rPropBlockQuote :: Bool
282286 , rPropForceSize :: Maybe Pixels
287+ , rSolidFill :: Maybe Color
288+ -- TODO: Make a full underline data type with
289+ -- the different options.
290+ , rPropUnderline :: Bool
283291 } deriving (Show, Eq)
284292
285293instance Default RunProps where
@@ -292,6 +300,8 @@ instance Default RunProps where
292300 , rPropCode = False
293301 , rPropBlockQuote = False
294302 , rPropForceSize = Nothing
303+ , rSolidFill = Nothing
304+ , rPropUnderline = False
295305 }
296306
297307data PicProps = PicProps { picPropLink :: Maybe LinkTarget
@@ -391,8 +401,17 @@ blockToParagraphs (LineBlock ilsList) = do
391401 return [Paragraph pProps parElems]
392402-- TODO: work out the attributes
393403blockToParagraphs (CodeBlock attr str) =
394− local (\r -> r{envParaProps = def{pPropMarginLeft = Just 100}}) $
395− blockToParagraphs $ Para [Code attr str]
404+ local (\r -> r{ envParaProps = def{pPropMarginLeft = Just 100}
405+ , envRunProps = (envRunProps r){rPropCode = True}}) $ do
406+ mbSty <- writerHighlightStyle <$> asks envOpts
407+ synMap <- writerSyntaxMap <$> asks envOpts
408+ case mbSty of
409+ Just sty ->
410+ case highlight synMap (formatSourceLines sty) attr str of
411+ Right pElems -> do pProps <- asks envParaProps
412+ return $ [Paragraph pProps pElems]
413+ Left _ -> blockToParagraphs $ Para [Str str]
414+ Nothing -> blockToParagraphs $ Para [Str str]
396415-- We can't yet do incremental lists, but we should render a
397416-- (BlockQuote List) as a list to maintain compatibility with other
398417-- formats.
@@ -878,3 +897,29 @@ documentToPresentation opts (Pandoc meta blks) =
878897 docProps = metaToDocProps meta
879898 in
880899 (Presentation docProps presSlides, msgs)
900+
901+-- --------------------------------------------------------------
902+
903+applyTokStyToRunProps :: TokenStyle -> RunProps -> RunProps
904+applyTokStyToRunProps tokSty rProps =
905+ rProps{ rSolidFill = tokenColor tokSty <|> rSolidFill rProps
906+ , rPropBold = tokenBold tokSty || rPropBold rProps
907+ , rPropItalics = tokenItalic tokSty || rPropItalics rProps
908+ , rPropUnderline = tokenUnderline tokSty || rPropUnderline rProps
909+ }
910+
911+formatToken :: Style -> Token -> ParaElem
912+formatToken sty (tokType, txt) =
913+ let rProps = def{rPropCode = True, rSolidFill = defaultColor sty}
914+ rProps' = case M.lookup tokType (tokenStyles sty) of
915+ Just tokSty -> applyTokStyToRunProps tokSty rProps
916+ Nothing -> rProps
917+ in
918+ Run rProps' $ T.unpack txt
919+
920+formatSourceLine :: Style -> FormatOptions -> SourceLine -> [ParaElem]
921+formatSourceLine sty _ srcLn = map (formatToken sty) srcLn
922+
923+formatSourceLines :: Style -> FormatOptions -> [SourceLine] -> [ParaElem]
924+formatSourceLines sty opts srcLns = intercalate [Break] $
925+ map (formatSourceLine sty opts) srcLns