aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJesse Rosenthal <jrosenthal@jhu.edu>2018-01-18 12:34:19 -0500
committerJesse Rosenthal <jrosenthal@jhu.edu>2018-01-18 17:33:05 -0500
commitd0a895acee371b13a9c31873c10dd124e04564d1 (patch)
tree7db7fa2ba3bbb2110c08bb6bab2189c048e5a4e6 /src
parent63b10cf15744594bc66cd73932775d3906da910d (diff)
downloadpandoc-d0a895acee371b13a9c31873c10dd124e04564d1.tar.gz
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.
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Output.hs57
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Presentation.hs49
2 files changed, 82 insertions, 24 deletions
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