From cdbe45e8ee1c5b87516ad020584576a22fdb28f4 Mon Sep 17 00:00:00 2001
From: Jesse Rosenthal <jrosenthal@jhu.edu>
Date: Tue, 27 Feb 2018 09:09:45 -0500
Subject: Powerpoint writer: Remove empty slides

Make sure there are no empty slides in the pptx output. Because of the
way that slides were split, these could be accidentally produced by
comments after images.

When animations are added, there will be a way to add an empty slide
with either incremental lists or pauses.

Test outputs checked with MS PowerPoint (Office 2013, Windows 10,
VBox). Both files have expected output and are not corrupted.
---
 src/Text/Pandoc/Writers/Powerpoint/Presentation.hs |  40 +++++++++++++++++++--
 test/Tests/Writers/Powerpoint.hs                   |   4 +++
 test/pptx/remove_empty_slides.native               |   5 +++
 test/pptx/remove_empty_slides.pptx                 | Bin 0 -> 43784 bytes
 test/pptx/remove_empty_slides_templated.pptx       | Bin 0 -> 411101 bytes
 5 files changed, 47 insertions(+), 2 deletions(-)
 create mode 100644 test/pptx/remove_empty_slides.native
 create mode 100644 test/pptx/remove_empty_slides.pptx
 create mode 100644 test/pptx/remove_empty_slides_templated.pptx

diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
index ac7c86945..c818df124 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
@@ -76,6 +76,7 @@ import Data.Maybe (maybeToList, fromMaybe)
 import Text.Pandoc.Highlighting
 import qualified Data.Text as T
 import Control.Applicative ((<|>))
+import Data.Char (isSpace)
 import Skylighting
 
 data WriterEnv = WriterEnv { envMetadata :: Meta
@@ -229,7 +230,6 @@ data Paragraph = Paragraph { paraProps :: ParaProps
                            , paraElems  :: [ParaElem]
                            } deriving (Show, Eq)
 
-
 data BulletType = Bullet
                 | AutoNumbering ListAttributes
   deriving (Show, Eq)
@@ -853,6 +853,41 @@ replaceAnchor (Run rProps s)
       return $ Run rProps' s
 replaceAnchor pe = return pe
 
+emptyParaElem :: ParaElem -> Bool
+emptyParaElem (Run _ s) =
+  null $ dropWhile isSpace $ reverse $ dropWhile isSpace $ reverse s
+emptyParaElem (MathElem _ ts) =
+  null $ dropWhile isSpace $ reverse $ dropWhile isSpace $ reverse $ unTeXString ts
+emptyParaElem _ = False
+
+emptyParagraph :: Paragraph -> Bool
+emptyParagraph para = all emptyParaElem $ paraElems para
+
+
+emptyShape :: Shape -> Bool
+emptyShape (TextBox paras) = all emptyParagraph $ paras
+emptyShape _ = False
+
+emptyLayout :: Layout -> Bool
+emptyLayout layout = case layout of
+  MetadataSlide title subtitle authors date ->
+    all emptyParaElem title &&
+    all emptyParaElem subtitle &&
+    all (all emptyParaElem) authors &&
+    all emptyParaElem date
+  TitleSlide hdr -> all emptyParaElem hdr
+  ContentSlide hdr shapes ->
+    all emptyParaElem hdr &&
+    all emptyShape shapes
+  TwoColumnSlide hdr shapes1 shapes2 ->
+    all emptyParaElem hdr &&
+    all emptyShape shapes1 &&
+    all emptyShape shapes2
+
+emptySlide :: Slide -> Bool
+emptySlide (Slide _ layout Nothing) = emptyLayout layout
+emptySlide _ = False
+
 blocksToPresentationSlides :: [Block] -> Pres [Slide]
 blocksToPresentationSlides blks = do
   opts <- asks envOpts
@@ -893,7 +928,8 @@ blocksToPresentationSlides blks = do
                             return [endNotesSlide]
 
   let slides = metadataslides ++ tocSlides ++ bodyslides ++ endNotesSlides
-  mapM (applyToSlide replaceAnchor) slides
+      slides' = filter (not . emptySlide) slides
+  mapM (applyToSlide replaceAnchor) slides'
 
 metaToDocProps :: Meta -> DocProps
 metaToDocProps meta =
diff --git a/test/Tests/Writers/Powerpoint.hs b/test/Tests/Writers/Powerpoint.hs
index fc5f9accc..bca39c24f 100644
--- a/test/Tests/Writers/Powerpoint.hs
+++ b/test/Tests/Writers/Powerpoint.hs
@@ -77,4 +77,8 @@ tests = groupPptxTests [ pptxTests "Inline formatting"
                          def
                          "pptx/speaker_notes.native"
                          "pptx/speaker_notes.pptx"
+                       , pptxTests "remove empty slides"
+                         def
+                         "pptx/remove_empty_slides.native"
+                         "pptx/remove_empty_slides.pptx"
                        ]
diff --git a/test/pptx/remove_empty_slides.native b/test/pptx/remove_empty_slides.native
new file mode 100644
index 000000000..51c042281
--- /dev/null
+++ b/test/pptx/remove_empty_slides.native
@@ -0,0 +1,5 @@
+[Para [Str "Content"]
+,Para [Image ("",[],[]) [] ("lalune.jpg",""),Space,RawInline (Format "html") "<!--  -->"]
+,HorizontalRule
+,HorizontalRule
+,Para [Str "More",Space,Str "content"]]
diff --git a/test/pptx/remove_empty_slides.pptx b/test/pptx/remove_empty_slides.pptx
new file mode 100644
index 000000000..3b4843aa6
Binary files /dev/null and b/test/pptx/remove_empty_slides.pptx differ
diff --git a/test/pptx/remove_empty_slides_templated.pptx b/test/pptx/remove_empty_slides_templated.pptx
new file mode 100644
index 000000000..1efe33212
Binary files /dev/null and b/test/pptx/remove_empty_slides_templated.pptx differ
-- 
cgit v1.2.3