pptx: Make first heading title if slide level is 0

Before this commit, the pptx writer adds a slide break before any table,
“columns” div, or paragraph starting with an image, unless the only
thing before it on the same slide is a heading at the slide level. In
that case, the item and heading are kept on the same slide, and the
heading is used as the slide title (inserted into the layout’s “title”
placeholder).

However, if the slide level is set to 0 (as was recently enabled) this
makes it impossible to have a slide with a title which contains any of
those items in its body.

This commit changes this behaviour: now if the slide level is 0, then
items will be kept with a heading of any level, if the heading’s the
only thing before the item on the same slide.

src/Text/Pandoc/Writers/Powerpoint/Presentation.hs

@@ -604,7 +604,7 @@ splitBlocks' cur acc (Para (il:ils) : blks) | isImage il = do
                      then span isNotesDiv blks
                      else ([], blks)
   case cur of
-    [Header n _ _] | n == slideLevel ->
+    [Header n _ _] | n == slideLevel || slideLevel == 0 ->
                             splitBlocks' []
                             (acc ++ [cur ++ [Para [il]] ++ nts])
                             (if null ils then blks' else Para ils : blks')
@@ -615,14 +615,14 @@ splitBlocks' cur acc (tbl@Table{} : blks) = do
   slideLevel <- asks envSlideLevel
   let (nts, blks') = span isNotesDiv blks
   case cur of
-    [Header n _ _] | n == slideLevel ->
+    [Header n _ _] | n == slideLevel || slideLevel == 0 ->
                             splitBlocks' [] (acc ++ [cur ++ [tbl] ++ nts]) blks'
     _ ->  splitBlocks' [] (acc ++ ([cur | not (null cur)]) ++ [tbl : nts]) blks'
 splitBlocks' cur acc (d@(Div (_, classes, _) _): blks) | "columns" `elem` classes =  do
   slideLevel <- asks envSlideLevel
   let (nts, blks') = span isNotesDiv blks
   case cur of
-    [Header n _ _] | n == slideLevel ->
+    [Header n _ _] | n == slideLevel || slideLevel == 0 ->
                             splitBlocks' [] (acc ++ [cur ++ [d] ++ nts]) blks'
     _ ->  splitBlocks' [] (acc ++ ([cur | not (null cur)]) ++ [d : nts]) blks'
 splitBlocks' cur acc (blk : blks) = splitBlocks' (cur ++ [blk]) acc blks
@@ -630,25 +630,10 @@ splitBlocks' cur acc (blk : blks) = splitBlocks' (cur ++ [blk]) acc blks
 splitBlocks :: [Block] -> Pres [[Block]]
 splitBlocks = splitBlocks' [] []
 
-blocksToSlide' :: Int -> [Block] -> SpeakerNotes -> Pres Slide
-blocksToSlide' lvl (Header n (ident, _, _) ils : blks) spkNotes
-  | n < lvl = do
-      registerAnchorId ident
-      sldId <- asks envCurSlideId
-      hdr <- inlinesToParElems ils
-      return $ Slide sldId (TitleSlide hdr) spkNotes
-  | n == lvl = do
-      registerAnchorId ident
-      hdr <- inlinesToParElems ils
-      -- Now get the slide without the header, and then add the header
-      -- in.
-      slide <- blocksToSlide' lvl blks spkNotes
-      let layout = case slideLayout slide of
-            ContentSlide _ cont          -> ContentSlide hdr cont
-            TwoColumnSlide _ contL contR -> TwoColumnSlide hdr contL contR
-            layout'                     -> layout'
-      return $ slide{slideLayout = layout}
-blocksToSlide' _ (blk : blks) spkNotes
+-- | Assuming the slide title is already handled, convert these blocks to the
+-- body content for the slide.
+bodyBlocksToSlide :: Int -> [Block] -> SpeakerNotes -> Pres Slide
+bodyBlocksToSlide _ (blk : blks) spkNotes
   | Div (_, classes, _) divBlks <- blk
   , "columns" `elem` classes
   , Div (_, clsL, _) blksL : Div (_, clsR, _) blksR : remaining <- divBlks
@@ -669,7 +654,7 @@ blocksToSlide' _ (blk : blks) spkNotes
         sldId
         (TwoColumnSlide [] shapesL shapesR)
         spkNotes
-blocksToSlide' _ (blk : blks) spkNotes = do
+bodyBlocksToSlide _ (blk : blks) spkNotes = do
       inNoteSlide <- asks envInNoteSlide
       shapes <- if inNoteSlide
                 then forceFontSize noteSize $ blocksToShapes (blk : blks)
@@ -680,7 +665,7 @@ blocksToSlide' _ (blk : blks) spkNotes = do
         sldId
         (ContentSlide [] shapes)
         spkNotes
-blocksToSlide' _ [] spkNotes = do
+bodyBlocksToSlide _ [] spkNotes = do
   sldId <- asks envCurSlideId
   return $
     Slide
@@ -688,6 +673,26 @@ blocksToSlide' _ [] spkNotes = do
     (ContentSlide [] [])
     spkNotes
 
+blocksToSlide' :: Int -> [Block] -> SpeakerNotes -> Pres Slide
+blocksToSlide' lvl (Header n (ident, _, _) ils : blks) spkNotes
+  | n < lvl = do
+      registerAnchorId ident
+      sldId <- asks envCurSlideId
+      hdr <- inlinesToParElems ils
+      return $ Slide sldId (TitleSlide hdr) spkNotes
+  | n == lvl || lvl == 0 = do
+      registerAnchorId ident
+      hdr <- inlinesToParElems ils
+      -- Now get the slide without the header, and then add the header
+      -- in.
+      slide <- bodyBlocksToSlide lvl blks spkNotes
+      let layout = case slideLayout slide of
+            ContentSlide _ cont          -> ContentSlide hdr cont
+            TwoColumnSlide _ contL contR -> TwoColumnSlide hdr contL contR
+            layout'                     -> layout'
+      return $ slide{slideLayout = layout}
+blocksToSlide' lvl blks spkNotes = bodyBlocksToSlide lvl blks spkNotes
+
 blockToSpeakerNotes :: Block -> Pres SpeakerNotes
 blockToSpeakerNotes (Div (_, ["notes"], _) blks) =
   local (\env -> env{envInSpeakerNotes=True}) $

test/Tests/Writers/Powerpoint.hs

@@ -146,4 +146,29 @@ tests = groupPptxTests [ pptxTests "Inline formatting"
                                  [(pack "monofont", toVal $ pack "Consolas")] }
                          "pptx/code.native"
                          "pptx/code-custom.pptx"
+                       , pptxTests ("Using slide level 0, if the first thing on "
+                                    <> "a slide is a h1 it's used as the "
+                                    <> "slide title")
+                         def { writerSlideLevel = Just 0 }
+                         "pptx/slide-level-0-h1-with-image.native"
+                         "pptx/slide-level-0-h1-with-image.pptx"
+                       , pptxTests ("Using slide level 0, if the first thing on "
+                                    <> "a slide is a h2 it's used as the "
+                                    <> "slide title")
+                         def { writerSlideLevel = Just 0 }
+                         "pptx/slide-level-0-h2-with-image.native"
+                         "pptx/slide-level-0-h2-with-image.pptx"
+                       , pptxTests ("Using slide level 0, if the first thing on "
+                                    <> "a slide is a heading it's used as the "
+                                    <> "slide title (works with a table)")
+                         def { writerSlideLevel = Just 0 }
+                         "pptx/slide-level-0-h1-with-table.native"
+                         "pptx/slide-level-0-h1-with-table.pptx"
+                       , pptxTests ("Using slide level 0, if the first thing on "
+                                    <> "a slide is a heading it's used as the "
+                                    <> "slide title (two headings forces a "
+                                    <> "slide break though)")
+                         def { writerSlideLevel = Just 0 }
+                         "pptx/slide-level-0-h1-h2-with-table.native"
+                         "pptx/slide-level-0-h1-h2-with-table.pptx"
                        ]

test/pptx/slide-level-0-h1-h2-with-table.native

@@ -0,0 +1,14 @@
+[Header 1 ("hello",[],[]) [Str "Hello"]
+,Header 2 ("there",[],[]) [Str "There"]
+,Table ("",[],[]) (Caption Nothing
+ [])
+ [(AlignDefault,ColWidth 5.555555555555555e-2)]
+ (TableHead ("",[],[])
+ [])
+ [(TableBody ("",[],[]) (RowHeadColumns 0)
+  []
+  [Row ("",[],[])
+   [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
+    [Plain [Str "1"]]]])]
+ (TableFoot ("",[],[])
+ [])]

test/pptx/slide-level-0-h1-with-image.native

@@ -0,0 +1,2 @@
+[Header 1 ("hello",[],[]) [Str "Hello"]
+,Para [Image ("",[],[]) [Str "An",Space,Str "image"] ("lalune.jpg","fig:")]]

test/pptx/slide-level-0-h1-with-table.native

@@ -0,0 +1,13 @@
+[Header 1 ("hello",[],[]) [Str "Hello"]
+,Table ("",[],[]) (Caption Nothing
+ [])
+ [(AlignDefault,ColWidth 5.555555555555555e-2)]
+ (TableHead ("",[],[])
+ [])
+ [(TableBody ("",[],[]) (RowHeadColumns 0)
+  []
+  [Row ("",[],[])
+   [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
+    [Plain [Str "1"]]]])]
+ (TableFoot ("",[],[])
+ [])]

test/pptx/slide-level-0-h2-with-image.native

@@ -0,0 +1,2 @@
+[Header 2 ("hello",[],[]) [Str "Hello"]
+,Para [Image ("",[],[]) [Str "An",Space,Str "image"] ("lalune.jpg","fig:")]]