summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJesse Rosenthal <jrosenthal@jhu.edu>2018-02-27 09:09:45 -0500
committerJesse Rosenthal <jrosenthal@jhu.edu>2018-02-27 09:12:17 -0500
commitcdbe45e8ee1c5b87516ad020584576a22fdb28f4 (patch)
treec0f3d4f139b7017c5a8e82b7ffc28684f68ac3f8
parentab1bee58e54be2f9bcafa56068a35dce292b6b00 (diff)
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.
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Presentation.hs40
-rw-r--r--test/Tests/Writers/Powerpoint.hs4
-rw-r--r--test/pptx/remove_empty_slides.native5
-rw-r--r--test/pptx/remove_empty_slides.pptxbin0 -> 43784 bytes
-rw-r--r--test/pptx/remove_empty_slides_templated.pptxbin0 -> 411101 bytes
5 files changed, 47 insertions, 2 deletions
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
--- /dev/null
+++ b/test/pptx/remove_empty_slides.pptx
Binary files 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
--- /dev/null
+++ b/test/pptx/remove_empty_slides_templated.pptx
Binary files differ