From 8e5a79f264dd1ebe80e048397b6281e318d25e82 Mon Sep 17 00:00:00 2001
From: Emily Bourke <undergroundquizscene@protonmail.com>
Date: Fri, 20 Aug 2021 14:40:09 +0100
Subject: pptx: Make first heading title if slide level is 0
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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 | 53 ++++++++++++----------
 1 file changed, 29 insertions(+), 24 deletions(-)

(limited to 'src/Text')

diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
index 0400783e3..284b9ae62 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
+++ b/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}) $
-- 
cgit v1.2.3