diff options
| -rw-r--r-- | src/Text/Pandoc/Writers/Powerpoint/Presentation.hs | 40 | ||||
| -rw-r--r-- | test/Tests/Writers/Powerpoint.hs | 4 | ||||
| -rw-r--r-- | test/pptx/remove_empty_slides.native | 5 | ||||
| -rw-r--r-- | test/pptx/remove_empty_slides.pptx | bin | 0 -> 43784 bytes | |||
| -rw-r--r-- | test/pptx/remove_empty_slides_templated.pptx | bin | 0 -> 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 Binary files differnew file mode 100644 index 000000000..3b4843aa6 --- /dev/null +++ b/test/pptx/remove_empty_slides.pptx diff --git a/test/pptx/remove_empty_slides_templated.pptx b/test/pptx/remove_empty_slides_templated.pptx Binary files differnew file mode 100644 index 000000000..1efe33212 --- /dev/null +++ b/test/pptx/remove_empty_slides_templated.pptx |