aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--MANUAL.txt10
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Output.hs57
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Presentation.hs49
3 files changed, 87 insertions, 29 deletions
diff --git a/MANUAL.txt b/MANUAL.txt
index 4f785079b..ac4bdcd42 100644
--- a/MANUAL.txt
+++ b/MANUAL.txt
@@ -2265,11 +2265,11 @@ this syntax:
Here `mycode` is an identifier, `haskell` and `numberLines` are classes, and
`startFrom` is an attribute with value `100`. Some output formats can use this
information to do syntax highlighting. Currently, the only output formats
-that uses this information are HTML, LaTeX, Docx, and Ms. If highlighting
-is supported for your output format and language, then the code block above
-will appear highlighted, with numbered lines. (To see which languages are
-supported, type `pandoc --list-highlight-languages`.) Otherwise, the code
-block above will appear as follows:
+that uses this information are HTML, LaTeX, Docx, Ms, and PowerPoint. If
+highlighting is supported for your output format and language, then the code
+block above will appear highlighted, with numbered lines. (To see which
+languages are supported, type `pandoc --list-highlight-languages`.) Otherwise,
+the code block above will appear as follows:
<pre id="mycode" class="haskell numberLines" startFrom="100">
<code>
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-02 15:50:49 +0000