Powerpoint code formatting is now context dependent (#5573)

This commit alters the way in which the Powerpoint writer treats
inline code and code blocks.

- Inline code is now formatted at the same size as the surrounding
  text.
- Code blocks are now given a margin and font size according to their
  level.
- Furthermore this commit allows changing the font with which code is
  formatted via the `monofont` option.

Tested in
- PowerPoint 365 for Windows - 1808 (Build 10730.20344 Click-to-Run)
- PowerPoint 365 for Mac - 16.26 (19060901)

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
 -------------------
 

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

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

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"
                        ]

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"]]]