diff --git a/MANUAL.txt b/MANUAL.txt
index ccc1d7db6..879bef5a9 100644
--- a/MANUAL.txt
+++ b/MANUAL.txt
@@ -1557,6 +1557,15 @@ These variables change the appearance of PDF slides using [`beamer`].
`titlegraphic`
: image for title slide
+Variables for PowerPoint slide shows
+--------------------------------------
+
+These variables control the visual aspects of a slide show that are not easily
+controled via templates.
+
+`monofont`
+: font to use for code.
+
Variables for LaTeX
-------------------
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
index a45c09bd4..eed35565e 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
@@ -48,6 +48,14 @@ import Text.Pandoc.Writers.Math (convertMath)
import Text.Pandoc.Writers.Powerpoint.Presentation
import Skylighting (fromColor)
+-- |The 'EMU' type is used to specify sizes in English Metric Units.
+type EMU = Integer
+
+-- |The 'pixelsToEmu' function converts a size in pixels to one
+-- in English Metric Units. It assumes a DPI of 72.
+pixelsToEmu :: Pixels -> EMU
+pixelsToEmu = (12700 *)
+
-- This populates the global ids map with images already in the
-- template, so the ids won't be used by images introduced by the
-- user.
@@ -148,6 +156,18 @@ runP env st p = evalStateT (runReaderT p env) st
--------------------------------------------------------------------
+monospaceFont :: Monad m => P m String
+monospaceFont = do
+ vars <- writerVariables <$> asks envOpts
+ case lookup "monofont" vars of
+ Just s -> return s
+ Nothing -> return "Courier"
+
+fontSizeAttributes :: Monad m => RunProps -> P m [(String, String)]
+fontSizeAttributes RunProps { rPropForceSize = Just sz } =
+ return [("sz", (show $ sz * 100))]
+fontSizeAttributes _ = return []
+
copyFileToArchive :: PandocMonad m => Archive -> FilePath -> P m Archive
copyFileToArchive arch fp = do
refArchive <- asks envRefArchive
@@ -721,13 +741,8 @@ makePicElements layout picProps mInfo alt = do
paraElemToElements :: PandocMonad m => ParaElem -> P m [Element]
paraElemToElements Break = return [mknode "a:br" [] ()]
paraElemToElements (Run rpr s) = do
- let sizeAttrs = case rPropForceSize rpr of
- Just n -> [("sz", (show $ n * 100))]
- Nothing -> if rPropCode rpr
- -- hardcoded size for code for now
- then [("sz", "1800")]
- else []
- attrs = sizeAttrs ++
+ sizeAttrs <- fontSizeAttributes rpr
+ let attrs = sizeAttrs ++
(if rPropBold rpr then [("b", "1")] else []) ++
(if rPropItalics rpr then [("i", "1")] else []) ++
(if rPropUnderline rpr then [("u", "sng")] else []) ++
@@ -773,8 +788,9 @@ paraElemToElements (Run rpr s) = do
]
_ -> []
Nothing -> []
+ codeFont <- monospaceFont
let codeContents = if rPropCode rpr
- then [mknode "a:latin" [("typeface", "Courier")] ()]
+ then [mknode "a:latin" [("typeface", codeFont)] ()]
else []
let propContents = linkProps ++ colorContents ++ codeContents
return [mknode "a:r" [] [ mknode "a:rPr" attrs $ propContents
@@ -821,7 +837,11 @@ paragraphToElement par = do
let
attrs = [("lvl", show $ pPropLevel $ paraProps par)] ++
(case pPropMarginLeft (paraProps par) of
- Just px -> [("marL", show $ 12700 * px), ("indent", "0")]
+ Just px -> [("marL", show $ pixelsToEmu px)]
+ Nothing -> []
+ ) ++
+ (case pPropIndent (paraProps par) of
+ Just px -> [("indent", show $ pixelsToEmu px)]
Nothing -> []
) ++
(case pPropAlign (paraProps par) of
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
index ae36c961c..8667c79f4 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
@@ -33,6 +33,7 @@ module Text.Pandoc.Writers.Powerpoint.Presentation ( documentToPresentation
, TableProps(..)
, Strikethrough(..)
, Capitals(..)
+ , Pixels
, PicProps(..)
, URL
, TeXString(..)
@@ -226,6 +227,7 @@ data ParaProps = ParaProps { pPropMarginLeft :: Maybe Pixels
, pPropBullet :: Maybe BulletType
, pPropAlign :: Maybe Algnment
, pPropSpaceBefore :: Maybe Pixels
+ , pPropIndent :: Maybe Pixels
} deriving (Show, Eq)
instance Default ParaProps where
@@ -235,6 +237,7 @@ instance Default ParaProps where
, pPropBullet = Nothing
, pPropAlign = Nothing
, pPropSpaceBefore = Nothing
+ , pPropIndent = Just 0
}
newtype TeXString = TeXString {unTeXString :: String}
@@ -411,18 +414,23 @@ blockToParagraphs (LineBlock ilsList) = do
pProps <- asks envParaProps
return [Paragraph pProps parElems]
-- TODO: work out the attributes
-blockToParagraphs (CodeBlock attr str) =
- local (\r -> r{ envParaProps = def{pPropMarginLeft = Just 100}
+blockToParagraphs (CodeBlock attr str) = do
+ pProps <- asks envParaProps
+ local (\r -> r{ envParaProps = def{ pPropMarginLeft = Nothing
+ , pPropBullet = Nothing
+ , pPropLevel = pPropLevel pProps
+ , pPropIndent = Just 0
+ }
, 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]
+ mbSty <- writerHighlightStyle <$> asks envOpts
+ synMap <- writerSyntaxMap <$> asks envOpts
+ case mbSty of
+ Just sty ->
+ case highlight synMap (formatSourceLines sty) attr str of
+ Right pElems -> do pPropsNew <- asks envParaProps
+ return [Paragraph pPropsNew 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.
@@ -431,7 +439,9 @@ blockToParagraphs (BlockQuote (blk : blks)) | isListType blk = do
ps' <- blockToParagraphs $ BlockQuote blks
return $ ps ++ ps'
blockToParagraphs (BlockQuote blks) =
- local (\r -> r{ envParaProps = (envParaProps r){pPropMarginLeft = Just 100}
+ local (\r -> r{ envParaProps = (envParaProps r){ pPropMarginLeft = Just 100
+ , pPropIndent = Just 0
+ }
, envRunProps = (envRunProps r){rPropForceSize = Just blockQuoteSize}})$
concatMapM blockToParagraphs blks
-- TODO: work out the format
@@ -455,6 +465,7 @@ blockToParagraphs (BulletList blksLst) = do
, envParaProps = pProps{ pPropLevel = lvl + 1
, pPropBullet = Just Bullet
, pPropMarginLeft = Nothing
+ , pPropIndent = Nothing
}}) $
concatMapM multiParBullet blksLst
blockToParagraphs (OrderedList listAttr blksLst) = do
@@ -464,6 +475,7 @@ blockToParagraphs (OrderedList listAttr blksLst) = do
, envParaProps = pProps{ pPropLevel = lvl + 1
, pPropBullet = Just (AutoNumbering listAttr)
, pPropMarginLeft = Nothing
+ , pPropIndent = Nothing
}}) $
concatMapM multiParBullet blksLst
blockToParagraphs (DefinitionList entries) = do
diff --git a/test/Tests/Writers/Powerpoint.hs b/test/Tests/Writers/Powerpoint.hs
index eb4b584e5..c21ee49a4 100644
--- a/test/Tests/Writers/Powerpoint.hs
+++ b/test/Tests/Writers/Powerpoint.hs
@@ -115,4 +115,12 @@ tests = groupPptxTests [ pptxTests "Inline formatting"
def
"pptx/document-properties-short-desc.native"
"pptx/document-properties-short-desc.pptx"
+ , pptxTests "inline code and code blocks"
+ def
+ "pptx/code.native"
+ "pptx/code.pptx"
+ , pptxTests "inline code and code blocks, custom formatting"
+ def { writerVariables = [("monofont", "Consolas")] }
+ "pptx/code.native"
+ "pptx/code-custom.pptx"
]
diff --git a/test/pptx/code-custom.pptx b/test/pptx/code-custom.pptx
new file mode 100644
index 000000000..aa9b7692a
Binary files /dev/null and b/test/pptx/code-custom.pptx differ
diff --git a/test/pptx/code-custom_templated.pptx b/test/pptx/code-custom_templated.pptx
new file mode 100644
index 000000000..9aaef4cb5
Binary files /dev/null and b/test/pptx/code-custom_templated.pptx differ
diff --git a/test/pptx/code.native b/test/pptx/code.native
new file mode 100644
index 000000000..be7f512f7
--- /dev/null
+++ b/test/pptx/code.native
@@ -0,0 +1,21 @@
+[Header 1 ("header-with-inline-code",[],[]) [Str "Header",Space,Str "with",Space,Code ("",[],[]) "inline code"]
+,CodeBlock ("",[],[]) "Code at level 0"
+,BulletList
+ [[Para [Str "Bullet",Space,Str "item",Space,Str "with",Space,Code ("",[],[]) "inline code"]
+ ,CodeBlock ("",[],[]) "Code block at level 1"
+ ,BulletList
+ [[Para [Str "with",Space,Code ("",[],[]) "nested"]
+ ,CodeBlock ("",[],[]) "lvl2\nlvl2\nlvl2"
+ ,Header 2 ("second-heading-level-with-code",[],[]) [Str "Second",Space,Str "heading",Space,Str "level",Space,Str "with",Space,Code ("",[],[]) "code"]]]]]
+,Header 1 ("syntax-highlighting",[],[]) [Str "Syntax",Space,Str "highlighting"]
+,CodeBlock ("",["haskell"],[]) "id :: a -> a\nid x = x"
+,BulletList
+ [[Para [Str "Nested"]
+ ,CodeBlock ("",["haskell"],[]) "g :: Int -> Int\ng x = x * 3"]]
+,Header 1 ("two-column-slide",[],[]) [Str "Two",Space,Str "column",Space,Str "slide"]
+,Div ("",["columns"],[])
+ [Div ("",["column"],[("width","50%")])
+ [BulletList
+ [[Plain [Str "A",Space,Str "total",Space,Str "alternative",Space,Str "for",Space,Code ("",[],[]) "head"]]]]
+ ,Div ("",["column"],[("width","50%")])
+ [CodeBlock ("",[],[]) "safeHead :: [a] -> Maybe a\nsafeHead [] = Nothing\nsafeHead (x:_) = Just x"]]]
diff --git a/test/pptx/code.pptx b/test/pptx/code.pptx
new file mode 100644
index 000000000..1737ec757
Binary files /dev/null and b/test/pptx/code.pptx differ
diff --git a/test/pptx/code_templated.pptx b/test/pptx/code_templated.pptx
new file mode 100644
index 000000000..87fb560ef
Binary files /dev/null and b/test/pptx/code_templated.pptx differ