diff --git a/pandoc.cabal b/pandoc.cabal
index 0c8cf0d61..4881fe3a4 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -414,6 +414,11 @@ extra-source-files:
test/pptx/endnotes-toc/*.pptx
test/pptx/endnotes/input.native
test/pptx/endnotes/*.pptx
+ test/pptx/footer/input.native
+ test/pptx/footer/basic/*.pptx
+ test/pptx/footer/fixed-date/*.pptx
+ test/pptx/footer/higher-slide-number/*.pptx
+ test/pptx/footer/no-title-slide/*.pptx
test/pptx/images/input.native
test/pptx/images/*.pptx
test/pptx/incremental-lists/with-flag/input.native
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
index 1431469d3..acfd446de 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
@@ -2,6 +2,7 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{- |
@@ -159,7 +160,7 @@ data SlideLayoutsOf a = SlideLayouts
, comparison :: a
, contentWithCaption :: a
, blank :: a
- } deriving (Show, Functor, Foldable, Traversable)
+ } deriving (Show, Eq, Functor, Foldable, Traversable)
data SlideLayout = SlideLayout
{ slElement :: Element
@@ -197,12 +198,14 @@ data WriterState = WriterState { stLinkIds :: M.Map Int (M.Map Int LinkTarget)
-- (FP, Local ID, Global ID, Maybe Mime)
, stMediaIds :: M.Map Int [MediaInfo]
, stMediaGlobalIds :: M.Map FilePath Int
+ , stFooterInfo :: Maybe FooterInfo
} deriving (Show, Eq)
instance Default WriterState where
def = WriterState { stLinkIds = mempty
, stMediaIds = mempty
, stMediaGlobalIds = mempty
+ , stFooterInfo = Nothing
}
type P m = ReaderT WriterEnv (StateT WriterState m)
@@ -316,8 +319,14 @@ presentationToArchiveP p@(Presentation docProps slides) = do
else id
let newArch' = foldr f newArch slideLayouts
- -- Update the master to make sure it includes any layouts we've just added
master <- getMaster
+ refArchive <- asks envRefArchive
+ distArchive <- asks envDistArchive
+ presentationElement <- parseXml refArchive distArchive "ppt/presentation.xml"
+ modify (\s -> s {stFooterInfo =
+ getFooterInfo slideLayouts master presentationElement})
+
+ -- Update the master to make sure it includes any layouts we've just added
masterRels <- getMasterRels
let (updatedMasterElem, updatedMasterRelElem) = updateMasterElems slideLayouts master masterRels
updatedMasterEntry <- elemToEntry "ppt/slideMasters/slideMaster1.xml" updatedMasterElem
@@ -432,6 +441,56 @@ updateMasterElems layouts master masterRels = (updatedMaster, updatedMasterRels)
getIdAttribute (Elem e) = findAttr (QName "id" Nothing Nothing) e
getIdAttribute _ = Nothing
+data FooterInfo = FooterInfo
+ { fiDate :: SlideLayoutsOf (Maybe Element)
+ , fiFooter :: SlideLayoutsOf (Maybe Element)
+ , fiSlideNumber :: SlideLayoutsOf (Maybe Element)
+ , fiShowOnFirstSlide :: Bool
+ } deriving (Show, Eq)
+
+getFooterInfo :: SlideLayouts -> Element -> Element -> Maybe FooterInfo
+getFooterInfo layouts master presentation = do
+ let ns = elemToNameSpaces master
+ hf <- findChild (elemName ns "p" "hf") master
+ let fiDate = getShape "dt" hf . slElement <$> layouts
+ fiFooter = getShape "ftr" hf . slElement <$> layouts
+ fiSlideNumber = getShape "sldNum" hf . slElement <$> layouts
+ fiShowOnFirstSlide =
+ fromMaybe True
+ (getBooleanAttribute "showSpecialPlsOnTitleSld" presentation)
+ pure FooterInfo{..}
+ where
+ getShape t hf layout =
+ if fromMaybe True (getBooleanAttribute t hf)
+ then do
+ let ns = elemToNameSpaces layout
+ cSld <- findChild (elemName ns "p" "cSld") layout
+ spTree <- findChild (elemName ns "p" "spTree") cSld
+ let containsPlaceholder sp = fromMaybe False $ do
+ nvSpPr <- findChild (elemName ns "p" "nvSpPr") sp
+ nvPr <- findChild (elemName ns "p" "nvPr") nvSpPr
+ ph <- findChild (elemName ns "p" "ph") nvPr
+ placeholderType <- findAttr (QName "type" Nothing Nothing) ph
+ pure (placeholderType == t)
+ listToMaybe (filterChildren containsPlaceholder spTree)
+ else Nothing
+
+ getBooleanAttribute t e =
+ (`elem` ["1", "true"]) <$>
+ (findAttr (QName t Nothing Nothing) e)
+
+footerElements ::
+ PandocMonad m =>
+ (forall a. SlideLayoutsOf a -> a) ->
+ P m [Content]
+footerElements layout = do
+ footerInfo <- gets stFooterInfo
+ pure
+ $ Elem <$>
+ (toList (footerInfo >>= layout . fiDate)
+ <> toList (footerInfo >>= layout . fiFooter)
+ <> toList (footerInfo >>= layout . fiSlideNumber))
+
makeSlideIdMap :: Presentation -> M.Map SlideId Int
makeSlideIdMap (Presentation _ slides) =
M.fromList $ map slideId slides `zip` [1..]
@@ -1372,13 +1431,14 @@ contentToElement layout hdrShape shapes
(shapeId, element) <- nonBodyTextToElement layout [PHType "title"] hdrShape
let hdrShapeElements = [Elem element | not (null hdrShape)]
contentHeaderId = if null hdrShape then Nothing else shapeId
- content <- local
+ content' <- local
(\env -> env {envPlaceholder = Placeholder ObjType 0})
(shapesToElements layout shapes)
- let contentContentIds = mapMaybe fst content
- contentElements = snd <$> content
+ let contentContentIds = mapMaybe fst content'
+ contentElements = snd <$> content'
+ footer <- footerElements content
return ( Just ContentShapeIds{..}
- , buildSpTree ns spTree (hdrShapeElements <> contentElements)
+ , buildSpTree ns spTree (hdrShapeElements <> contentElements <> footer)
)
contentToElement _ _ _ = return (Nothing, mknode "p:sp" [] ())
@@ -1412,10 +1472,11 @@ twoColumnToElement layout hdrShape shapesL shapesR
contentElementsR = snd <$> contentR
-- let contentElementsL' = map (setIdx ns "1") contentElementsL
-- contentElementsR' = map (setIdx ns "2") contentElementsR
+ footer <- footerElements twoColumn
return
$ (Just TwoColumnShapeIds{..}, )
$ buildSpTree ns spTree
- $ hdrShapeElements <> contentElementsL <> contentElementsR
+ $ hdrShapeElements <> contentElementsL <> contentElementsR <> footer
twoColumnToElement _ _ _ _ = return (Nothing, mknode "p:sp" [] ())
data ComparisonShapeIds = ComparisonShapeIds
@@ -1456,6 +1517,7 @@ comparisonToElement layout hdrShape (shapesL1, shapesL2) (shapesR1, shapesR2)
(shapesToElements layout shapesR2)
let comparisonRightContentIds = mapMaybe fst contentR2
contentElementsR2 = snd <$> contentR2
+ footer <- footerElements comparison
return
$ (Just ComparisonShapeIds{..}, )
$ buildSpTree ns spTree
@@ -1464,7 +1526,7 @@ comparisonToElement layout hdrShape (shapesL1, shapesL2) (shapesR1, shapesR2)
, contentElementsL2
, contentElementsR1
, contentElementsR2
- ]
+ ] <> footer
comparisonToElement _ _ _ _= return (Nothing, mknode "p:sp" [] ())
data ContentWithCaptionShapeIds = ContentWithCaptionShapeIds
@@ -1495,13 +1557,14 @@ contentWithCaptionToElement layout hdrShape textShapes contentShapes
(shapesToElements layout contentShapes)
let contentWithCaptionContentIds = mapMaybe fst content
contentElements = snd <$> content
+ footer <- footerElements contentWithCaption
return
$ (Just ContentWithCaptionShapeIds{..}, )
$ buildSpTree ns spTree
$ mconcat [ hdrShapeElements
, textElements
, contentElements
- ]
+ ] <> footer
contentWithCaptionToElement _ _ _ _ = return (Nothing, mknode "p:sp" [] ())
blankToElement ::
@@ -1511,8 +1574,8 @@ blankToElement ::
blankToElement layout
| ns <- elemToNameSpaces layout
, Just cSld <- findChild (elemName ns "p" "cSld") layout
- , Just spTree <- findChild (elemName ns "p" "spTree") cSld = do
- return $ buildSpTree ns spTree []
+ , Just spTree <- findChild (elemName ns "p" "spTree") cSld =
+ buildSpTree ns spTree <$> footerElements blank
blankToElement _ = return $ mknode "p:sp" [] ()
newtype TitleShapeIds = TitleShapeIds
@@ -1531,7 +1594,10 @@ titleToElement layout titleElems
(shapeId, element) <- nonBodyTextToElement layout [PHType "title", PHType "ctrTitle"] titleElems
let titleShapeElements = [Elem element | not (null titleElems)]
titleHeaderId = if null titleElems then Nothing else shapeId
- return $ (Just TitleShapeIds{..}, ) $ buildSpTree ns spTree titleShapeElements
+ footer <- footerElements title
+ return
+ $ (Just TitleShapeIds{..}, )
+ $ buildSpTree ns spTree (titleShapeElements <> footer)
titleToElement _ _ = return (Nothing, mknode "p:sp" [] ())
data MetadataShapeIds = MetadataShapeIds
@@ -1561,13 +1627,20 @@ metadataToElement layout titleElems subtitleElems authorsElems dateElems
metadataTitleId = if null titleElems then Nothing else titleId
subtitleShapeElements = [subtitleElement | not (null subtitleAndAuthorElems)]
metadataSubtitleId = if null subtitleAndAuthorElems then Nothing else subtitleId
- dateShapeElements = [dateElement | not (null dateElems)]
+ footerInfo <- gets stFooterInfo
+ footer <- (if maybe False fiShowOnFirstSlide footerInfo
+ then id
+ else const []) <$> footerElements metadata
+ let dateShapeElements = [dateElement
+ | not (null dateElems
+ || isJust (footerInfo >>= metadata . fiDate))
+ ]
metadataDateId = if null dateElems then Nothing else dateId
return
$ (Just MetadataShapeIds{..}, )
$ buildSpTree ns spTree
- $ map Elem
- $ titleShapeElements <> subtitleShapeElements <> dateShapeElements
+ $ map Elem (titleShapeElements <> subtitleShapeElements <> dateShapeElements)
+ <> footer
metadataToElement _ _ _ _ _ = return (Nothing, mknode "p:sp" [] ())
slideToElement :: PandocMonad m => Slide -> P m Element
diff --git a/test/Tests/Writers/Powerpoint.hs b/test/Tests/Writers/Powerpoint.hs
index 6e676dc37..b2df80e5f 100644
--- a/test/Tests/Writers/Powerpoint.hs
+++ b/test/Tests/Writers/Powerpoint.hs
@@ -61,187 +61,216 @@ groupPptxTests pairs =
tests :: [TestTree]
-tests = groupPptxTests [ pptxTests "Inline formatting"
- def
- "pptx/inline-formatting/input.native"
- "pptx/inline-formatting/output.pptx"
- , pptxTests "Slide breaks (default slide-level)"
- def
- "pptx/slide-breaks/input.native"
- "pptx/slide-breaks/output.pptx"
- , pptxTests "slide breaks (slide-level set to 1)"
- def{ writerSlideLevel = Just 1 }
- "pptx/slide-breaks/input.native"
- "pptx/slide-breaks-slide-level-1/output.pptx"
- , pptxTests "lists"
- def
- "pptx/lists/input.native"
- "pptx/lists/output.pptx"
- , pptxTests "start ordered list at specified num"
- def
- "pptx/start-numbering-at/input.native"
- "pptx/start-numbering-at/output.pptx"
- , pptxTests "tables"
- def
- "pptx/tables/input.native"
- "pptx/tables/output.pptx"
- , pptxTests "table of contents"
- def{ writerTableOfContents = True }
- "pptx/slide-breaks/input.native"
- "pptx/slide-breaks-toc/output.pptx"
- , pptxTests "end notes"
- def
- "pptx/endnotes/input.native"
- "pptx/endnotes/output.pptx"
- , pptxTests "end notes, with table of contents"
- def { writerTableOfContents = True }
- "pptx/endnotes/input.native"
- "pptx/endnotes-toc/output.pptx"
- , pptxTests "images"
- def
- "pptx/images/input.native"
- "pptx/images/output.pptx"
- , pptxTests "two-column layout"
- def
- "pptx/two-column/all-text/input.native"
- "pptx/two-column/all-text/output.pptx"
- , pptxTests "two-column (not comparison)"
- def
- "pptx/two-column/text-and-image/input.native"
- "pptx/two-column/text-and-image/output.pptx"
- , pptxTests "speaker notes"
- def
- "pptx/speaker-notes/input.native"
- "pptx/speaker-notes/output.pptx"
- , pptxTests "speaker notes after a separating block"
- def
- "pptx/speaker-notes-afterseps/input.native"
- "pptx/speaker-notes-afterseps/output.pptx"
- , pptxTests "speaker notes after a separating header"
- def
- "pptx/speaker-notes-afterheader/input.native"
- "pptx/speaker-notes-afterheader/output.pptx"
- , pptxTests "speaker notes after metadata"
- def
- "pptx/speaker-notes-after-metadata/input.native"
- "pptx/speaker-notes-after-metadata/output.pptx"
- , pptxTests "remove empty slides"
- def
- "pptx/remove-empty-slides/input.native"
- "pptx/remove-empty-slides/output.pptx"
- , pptxTests "raw ooxml"
- def
- "pptx/raw-ooxml/input.native"
- "pptx/raw-ooxml/output.pptx"
- , pptxTests "metadata, custom properties"
- def
- "pptx/document-properties/input.native"
- "pptx/document-properties/output.pptx"
- , pptxTests "metadata, short description"
- def
- "pptx/document-properties-short-desc/input.native"
- "pptx/document-properties-short-desc/output.pptx"
- , pptxTests "inline code and code blocks"
- def
- "pptx/code/input.native"
- "pptx/code/output.pptx"
- , pptxTests "inline code and code blocks, custom formatting"
- def { writerVariables = Context $ M.fromList
- [(pack "monofont", toVal $ pack "Consolas")] }
- "pptx/code/input.native"
- "pptx/code-custom/output.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/input.native"
- "pptx/slide-level-0/h1-with-image/output.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/input.native"
- "pptx/slide-level-0/h2-with-image/output.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/input.native"
- "pptx/slide-level-0/h1-with-table/output.pptx"
- , pptxTests ("Using slide level 0, if the first thing on "
- <> "a slide is a heading it's used as the "
- <> "slide title (content with caption layout)")
- def { writerSlideLevel = Just 0 }
- "pptx/slide-level-0/h1-h2-with-table/input.native"
- "pptx/slide-level-0/h1-h2-with-table/output.pptx"
- , pptxTests ("comparison layout used when two columns "
- <> "contain text plus non-text")
- def
- "pptx/comparison/both-columns/input.native"
- "pptx/comparison/both-columns/output.pptx"
- , pptxTests ("comparison layout used even when only one "
- <> "column contains text plus non-text")
- def
- "pptx/comparison/one-column/input.native"
- "pptx/comparison/one-column/output.pptx"
- , pptxTests ("extra text in one column in comparison "
- <> "layout gets overlaid")
- def
- "pptx/comparison/extra-text/input.native"
- "pptx/comparison/extra-text/output.pptx"
- , pptxTests ("extra image in one column in comparison "
- <> "layout gets overlaid")
- def
- "pptx/comparison/extra-image/input.native"
- "pptx/comparison/extra-image/output.pptx"
- , pptxTests "comparison not used if the non-text comes first"
- def
- "pptx/comparison/non-text-first/input.native"
- "pptx/comparison/non-text-first/output.pptx"
- , pptxTests ("Heading, text and an image on the same "
- <> "slide uses the Content with Caption "
- <> "layout")
- def
- "pptx/content-with-caption/heading-text-image/input.native"
- "pptx/content-with-caption/heading-text-image/output.pptx"
- , pptxTests ("Text and an image on the same "
- <> "slide uses the Content with Caption "
- <> "layout")
- def
- "pptx/content-with-caption/text-image/input.native"
- "pptx/content-with-caption/text-image/output.pptx"
- , pptxTests ("If the image comes first, Content with "
- <> "Caption is not used")
- def
- "pptx/content-with-caption/image-text/input.native"
- "pptx/content-with-caption/image-text/output.pptx"
- , pptxTests ("If a slide contains only speaker notes, the "
- <> "Blank layout is used")
- def
- "pptx/blanks/just-speaker-notes/input.native"
- "pptx/blanks/just-speaker-notes/output.pptx"
- , pptxTests ("If a slide contains only an empty heading "
- <> "with a body of only non-breaking spaces"
- <> ", the Blank layout is used")
- def
- "pptx/blanks/nbsp-in-body/input.native"
- "pptx/blanks/nbsp-in-body/output.pptx"
- , pptxTests ("If a slide contains only a heading "
- <> "containing only non-breaking spaces, "
- <> "the Blank layout is used")
- def
- "pptx/blanks/nbsp-in-heading/input.native"
- "pptx/blanks/nbsp-in-heading/output.pptx"
- , pptxTests ("Incremental lists are supported")
- def { writerIncremental = True }
- "pptx/incremental-lists/with-flag/input.native"
- "pptx/incremental-lists/with-flag/output.pptx"
- , pptxTests ("One-off incremental lists are supported")
- def
- "pptx/incremental-lists/without-flag/input.native"
- "pptx/incremental-lists/without-flag/output.pptx"
- , pptxTests "Background images"
- def
- "pptx/background-image/input.native"
- "pptx/background-image/output.pptx"
- ]
+tests = let
+ regularTests =
+ groupPptxTests [ pptxTests "Inline formatting"
+ def
+ "pptx/inline-formatting/input.native"
+ "pptx/inline-formatting/output.pptx"
+ , pptxTests "Slide breaks (default slide-level)"
+ def
+ "pptx/slide-breaks/input.native"
+ "pptx/slide-breaks/output.pptx"
+ , pptxTests "slide breaks (slide-level set to 1)"
+ def{ writerSlideLevel = Just 1 }
+ "pptx/slide-breaks/input.native"
+ "pptx/slide-breaks-slide-level-1/output.pptx"
+ , pptxTests "lists"
+ def
+ "pptx/lists/input.native"
+ "pptx/lists/output.pptx"
+ , pptxTests "start ordered list at specified num"
+ def
+ "pptx/start-numbering-at/input.native"
+ "pptx/start-numbering-at/output.pptx"
+ , pptxTests "tables"
+ def
+ "pptx/tables/input.native"
+ "pptx/tables/output.pptx"
+ , pptxTests "table of contents"
+ def{ writerTableOfContents = True }
+ "pptx/slide-breaks/input.native"
+ "pptx/slide-breaks-toc/output.pptx"
+ , pptxTests "end notes"
+ def
+ "pptx/endnotes/input.native"
+ "pptx/endnotes/output.pptx"
+ , pptxTests "end notes, with table of contents"
+ def { writerTableOfContents = True }
+ "pptx/endnotes/input.native"
+ "pptx/endnotes-toc/output.pptx"
+ , pptxTests "images"
+ def
+ "pptx/images/input.native"
+ "pptx/images/output.pptx"
+ , pptxTests "two-column layout"
+ def
+ "pptx/two-column/all-text/input.native"
+ "pptx/two-column/all-text/output.pptx"
+ , pptxTests "two-column (not comparison)"
+ def
+ "pptx/two-column/text-and-image/input.native"
+ "pptx/two-column/text-and-image/output.pptx"
+ , pptxTests "speaker notes"
+ def
+ "pptx/speaker-notes/input.native"
+ "pptx/speaker-notes/output.pptx"
+ , pptxTests "speaker notes after a separating block"
+ def
+ "pptx/speaker-notes-afterseps/input.native"
+ "pptx/speaker-notes-afterseps/output.pptx"
+ , pptxTests "speaker notes after a separating header"
+ def
+ "pptx/speaker-notes-afterheader/input.native"
+ "pptx/speaker-notes-afterheader/output.pptx"
+ , pptxTests "speaker notes after metadata"
+ def
+ "pptx/speaker-notes-after-metadata/input.native"
+ "pptx/speaker-notes-after-metadata/output.pptx"
+ , pptxTests "remove empty slides"
+ def
+ "pptx/remove-empty-slides/input.native"
+ "pptx/remove-empty-slides/output.pptx"
+ , pptxTests "raw ooxml"
+ def
+ "pptx/raw-ooxml/input.native"
+ "pptx/raw-ooxml/output.pptx"
+ , pptxTests "metadata, custom properties"
+ def
+ "pptx/document-properties/input.native"
+ "pptx/document-properties/output.pptx"
+ , pptxTests "metadata, short description"
+ def
+ "pptx/document-properties-short-desc/input.native"
+ "pptx/document-properties-short-desc/output.pptx"
+ , pptxTests "inline code and code blocks"
+ def
+ "pptx/code/input.native"
+ "pptx/code/output.pptx"
+ , pptxTests "inline code and code blocks, custom formatting"
+ def { writerVariables = Context $ M.fromList
+ [(pack "monofont", toVal $ pack "Consolas")] }
+ "pptx/code/input.native"
+ "pptx/code-custom/output.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/input.native"
+ "pptx/slide-level-0/h1-with-image/output.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/input.native"
+ "pptx/slide-level-0/h2-with-image/output.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/input.native"
+ "pptx/slide-level-0/h1-with-table/output.pptx"
+ , pptxTests ("Using slide level 0, if the first thing on "
+ <> "a slide is a heading it's used as the "
+ <> "slide title (content with caption layout)")
+ def { writerSlideLevel = Just 0 }
+ "pptx/slide-level-0/h1-h2-with-table/input.native"
+ "pptx/slide-level-0/h1-h2-with-table/output.pptx"
+ , pptxTests ("comparison layout used when two columns "
+ <> "contain text plus non-text")
+ def
+ "pptx/comparison/both-columns/input.native"
+ "pptx/comparison/both-columns/output.pptx"
+ , pptxTests ("comparison layout used even when only one "
+ <> "column contains text plus non-text")
+ def
+ "pptx/comparison/one-column/input.native"
+ "pptx/comparison/one-column/output.pptx"
+ , pptxTests ("extra text in one column in comparison "
+ <> "layout gets overlaid")
+ def
+ "pptx/comparison/extra-text/input.native"
+ "pptx/comparison/extra-text/output.pptx"
+ , pptxTests ("extra image in one column in comparison "
+ <> "layout gets overlaid")
+ def
+ "pptx/comparison/extra-image/input.native"
+ "pptx/comparison/extra-image/output.pptx"
+ , pptxTests "comparison not used if the non-text comes first"
+ def
+ "pptx/comparison/non-text-first/input.native"
+ "pptx/comparison/non-text-first/output.pptx"
+ , pptxTests ("Heading, text and an image on the same "
+ <> "slide uses the Content with Caption "
+ <> "layout")
+ def
+ "pptx/content-with-caption/heading-text-image/input.native"
+ "pptx/content-with-caption/heading-text-image/output.pptx"
+ , pptxTests ("Text and an image on the same "
+ <> "slide uses the Content with Caption "
+ <> "layout")
+ def
+ "pptx/content-with-caption/text-image/input.native"
+ "pptx/content-with-caption/text-image/output.pptx"
+ , pptxTests ("If the image comes first, Content with "
+ <> "Caption is not used")
+ def
+ "pptx/content-with-caption/image-text/input.native"
+ "pptx/content-with-caption/image-text/output.pptx"
+ , pptxTests ("If a slide contains only speaker notes, the "
+ <> "Blank layout is used")
+ def
+ "pptx/blanks/just-speaker-notes/input.native"
+ "pptx/blanks/just-speaker-notes/output.pptx"
+ , pptxTests ("If a slide contains only an empty heading "
+ <> "with a body of only non-breaking spaces"
+ <> ", the Blank layout is used")
+ def
+ "pptx/blanks/nbsp-in-body/input.native"
+ "pptx/blanks/nbsp-in-body/output.pptx"
+ , pptxTests ("If a slide contains only a heading "
+ <> "containing only non-breaking spaces, "
+ <> "the Blank layout is used")
+ def
+ "pptx/blanks/nbsp-in-heading/input.native"
+ "pptx/blanks/nbsp-in-heading/output.pptx"
+ , pptxTests ("Incremental lists are supported")
+ def { writerIncremental = True }
+ "pptx/incremental-lists/with-flag/input.native"
+ "pptx/incremental-lists/with-flag/output.pptx"
+ , pptxTests ("One-off incremental lists are supported")
+ def
+ "pptx/incremental-lists/without-flag/input.native"
+ "pptx/incremental-lists/without-flag/output.pptx"
+ , pptxTests "Background images"
+ def
+ "pptx/background-image/input.native"
+ "pptx/background-image/output.pptx"
+ ]
+ referenceSpecificTests =
+ [ ooxmlTest
+ writePowerpoint
+ "Basic footer"
+ def { writerReferenceDoc = Just "pptx/footer/basic/reference.pptx"}
+ "pptx/footer/input.native"
+ "pptx/footer/basic/output.pptx"
+ , ooxmlTest
+ writePowerpoint
+ "Footer with fixed date, replaced by meta block date"
+ def { writerReferenceDoc = Just "pptx/footer/fixed-date/reference.pptx"}
+ "pptx/footer/input.native"
+ "pptx/footer/fixed-date/output.pptx"
+ , ooxmlTest
+ writePowerpoint
+ "Footer not shown on title slide"
+ def { writerReferenceDoc = Just "pptx/footer/no-title-slide/reference.pptx"}
+ "pptx/footer/input.native"
+ "pptx/footer/no-title-slide/output.pptx"
+ , ooxmlTest
+ writePowerpoint
+ "Footer with slide number starting from 3"
+ def { writerReferenceDoc = Just "pptx/footer/higher-slide-number/reference.pptx"}
+ "pptx/footer/input.native"
+ "pptx/footer/higher-slide-number/output.pptx"
+ ]
+ in regularTests <> referenceSpecificTests
diff --git a/test/pptx/footer/basic/output.pptx b/test/pptx/footer/basic/output.pptx
new file mode 100644
index 000000000..db8814418
Binary files /dev/null and b/test/pptx/footer/basic/output.pptx differ
diff --git a/test/pptx/footer/basic/reference.pptx b/test/pptx/footer/basic/reference.pptx
new file mode 100644
index 000000000..61f926fa6
Binary files /dev/null and b/test/pptx/footer/basic/reference.pptx differ
diff --git a/test/pptx/footer/fixed-date/output.pptx b/test/pptx/footer/fixed-date/output.pptx
new file mode 100644
index 000000000..85854a744
Binary files /dev/null and b/test/pptx/footer/fixed-date/output.pptx differ
diff --git a/test/pptx/footer/fixed-date/reference.pptx b/test/pptx/footer/fixed-date/reference.pptx
new file mode 100644
index 000000000..78bd3ce0d
Binary files /dev/null and b/test/pptx/footer/fixed-date/reference.pptx differ
diff --git a/test/pptx/footer/higher-slide-number/output.pptx b/test/pptx/footer/higher-slide-number/output.pptx
new file mode 100644
index 000000000..c5bc3d047
Binary files /dev/null and b/test/pptx/footer/higher-slide-number/output.pptx differ
diff --git a/test/pptx/footer/higher-slide-number/reference.pptx b/test/pptx/footer/higher-slide-number/reference.pptx
new file mode 100644
index 000000000..6ada45399
Binary files /dev/null and b/test/pptx/footer/higher-slide-number/reference.pptx differ
diff --git a/test/pptx/footer/input.native b/test/pptx/footer/input.native
new file mode 100644
index 000000000..2c0ae5c06
--- /dev/null
+++ b/test/pptx/footer/input.native
@@ -0,0 +1,66 @@
+Pandoc (Meta {unMeta = fromList [("author",MetaInlines [Str "Me"]),("date",MetaInlines [Str "14/09/1995"]),("title",MetaInlines [Str "Slides"])]})
+[Header 2 ("slide-1",[],[]) [Str "Slide",Space,Str "1"]
+,Para [Str "Hello",Space,Str "there"]
+,Header 1 ("layouts",[],[]) [Str "Layouts"]
+,Header 2 ("slide-3",[],[]) [Str "Slide",Space,Str "3"]
+,Para [Str "Does",Space,Str "it",Space,Str "work",Space,Str "on",Space,Str "other",Space,Str "layouts?"]
+,Table ("",[],[]) (Caption Nothing
+ [])
+ [(AlignDefault,ColWidth 5.555555555555555e-2)
+ ,(AlignDefault,ColWidth 5.555555555555555e-2)]
+ (TableHead ("",[],[])
+ [])
+ [(TableBody ("",[],[]) (RowHeadColumns 0)
+ []
+ [Row ("",[],[])
+ [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
+ [Plain [Str "1"]]
+ ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
+ [Plain [Str "2"]]]])]
+ (TableFoot ("",[],[])
+ [])
+,Header 2 ("slide-4",[],[]) [Str "Slide",Space,Str "4"]
+,Div ("",["columns"],[])
+ [Div ("",["column"],[])
+ [Para [Str "hello",Space,Str "hello"]]
+ ,Div ("",["column"],[])
+ [Para [Str "goood",Space,Str "bye"]]]
+,Header 2 ("slide-5",[],[]) [Str "Slide",Space,Str "5"]
+,Div ("",["columns"],[])
+ [Div ("",["column"],[])
+ [Para [Str "Hello",Space,Str "there"]
+ ,Table ("",[],[]) (Caption Nothing
+ [])
+ [(AlignDefault,ColWidth 5.555555555555555e-2)
+ ,(AlignDefault,ColWidth 5.555555555555555e-2)]
+ (TableHead ("",[],[])
+ [])
+ [(TableBody ("",[],[]) (RowHeadColumns 0)
+ []
+ [Row ("",[],[])
+ [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
+ [Plain [Str "1"]]
+ ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
+ [Plain [Str "2"]]]])]
+ (TableFoot ("",[],[])
+ [])]
+ ,Div ("",["column"],[])
+ [Para [Str "oh",Space,Str "wait"]
+ ,Table ("",[],[]) (Caption Nothing
+ [])
+ [(AlignDefault,ColWidth 5.555555555555555e-2)
+ ,(AlignDefault,ColWidth 5.555555555555555e-2)]
+ (TableHead ("",[],[])
+ [])
+ [(TableBody ("",[],[]) (RowHeadColumns 0)
+ []
+ [Row ("",[],[])
+ [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
+ [Plain [Str "1"]]
+ ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
+ [Plain [Str "2"]]]])]
+ (TableFoot ("",[],[])
+ [])]]
+,Header 2 ("section",[],[]) []
+,Div ("",["notes"],[])
+ [Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "blank",Space,Str "slide:",Space,Str "does",Space,Str "it",Space,Str "have",Space,Str "a",Space,Str "footer?"]]]
diff --git a/test/pptx/footer/no-title-slide/output.pptx b/test/pptx/footer/no-title-slide/output.pptx
new file mode 100644
index 000000000..d1475bf1f
Binary files /dev/null and b/test/pptx/footer/no-title-slide/output.pptx differ
diff --git a/test/pptx/footer/no-title-slide/reference.pptx b/test/pptx/footer/no-title-slide/reference.pptx
new file mode 100644
index 000000000..ecd524a9b
Binary files /dev/null and b/test/pptx/footer/no-title-slide/reference.pptx differ