aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorEmily Bourke <undergroundquizscene@protonmail.com>2021-09-17 13:53:54 +0100
committerJohn MacFarlane <jgm@berkeley.edu>2021-09-18 09:55:45 -0700
commit4a5ed7e04a0186afe159b030b5bf52260cb47da4 (patch)
tree2a3610cfb5f5f17020b5432f5a688ada3ee48ebb /src
parent50adea220d09e445572e94e225fa7a81b3b2bf89 (diff)
downloadpandoc-4a5ed7e04a0186afe159b030b5bf52260cb47da4.tar.gz
pptx-footers: Replace fixed dates with yaml date
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Output.hs43
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Presentation.hs9
2 files changed, 44 insertions, 8 deletions
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
index acfd446de..f4700e8c1 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
@@ -323,8 +323,10 @@ presentationToArchiveP p@(Presentation docProps slides) = do
refArchive <- asks envRefArchive
distArchive <- asks envDistArchive
presentationElement <- parseXml refArchive distArchive "ppt/presentation.xml"
- modify (\s -> s {stFooterInfo =
- getFooterInfo slideLayouts master presentationElement})
+ modify (\s ->
+ s {stFooterInfo =
+ getFooterInfo (dcDate docProps) slideLayouts master presentationElement
+ })
-- Update the master to make sure it includes any layouts we've just added
masterRels <- getMasterRels
@@ -448,11 +450,19 @@ data FooterInfo = FooterInfo
, fiShowOnFirstSlide :: Bool
} deriving (Show, Eq)
-getFooterInfo :: SlideLayouts -> Element -> Element -> Maybe FooterInfo
-getFooterInfo layouts master presentation = do
+getFooterInfo :: Maybe Text -> SlideLayouts -> Element -> Element -> Maybe FooterInfo
+getFooterInfo date layouts master presentation = do
let ns = elemToNameSpaces master
hf <- findChild (elemName ns "p" "hf") master
- let fiDate = getShape "dt" hf . slElement <$> layouts
+ let fiDate = let
+ f layoutDate =
+ case date of
+ Nothing -> layoutDate
+ Just d ->
+ if dateIsAutomatic (elemToNameSpaces layoutDate) layoutDate
+ then layoutDate
+ else replaceDate d layoutDate
+ in fmap f . getShape "dt" hf . slElement <$> layouts
fiFooter = getShape "ftr" hf . slElement <$> layouts
fiSlideNumber = getShape "sldNum" hf . slElement <$> layouts
fiShowOnFirstSlide =
@@ -475,6 +485,29 @@ getFooterInfo layouts master presentation = do
listToMaybe (filterChildren containsPlaceholder spTree)
else Nothing
+ dateIsAutomatic :: NameSpaces -> Element -> Bool
+ dateIsAutomatic ns shape = isJust $ do
+ txBody <- findChild (elemName ns "p" "txBody") shape
+ p <- findChild (elemName ns "a" "p") txBody
+ findChild (elemName ns "a" "fld") p
+
+ replaceDate :: Text -> Element -> Element
+ replaceDate newDate e =
+ e { elContent =
+ case (elName e) of
+ QName "t" _ (Just "a") ->
+ [ Text (CData { cdVerbatim = CDataText
+ , cdData = newDate
+ , cdLine = Nothing
+ })
+ ]
+ _ -> ifElem (replaceDate newDate) <$> elContent e
+ }
+
+ ifElem :: (Element -> Element) -> (Content -> Content)
+ ifElem f (Elem e) = Elem (f e)
+ ifElem _ c = c
+
getBooleanAttribute t e =
(`elem` ["1", "true"]) <$>
(findAttr (QName t Nothing Nothing) e)
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
index fb4518bd7..327774cd8 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
@@ -55,7 +55,6 @@ import Text.Pandoc.Slides (getSlideLevel)
import Text.Pandoc.Options
import Text.Pandoc.Logging
import Text.Pandoc.Walk
-import Data.Time (UTCTime)
import qualified Text.Pandoc.Shared as Shared -- so we don't overlap "Element"
import Text.Pandoc.Shared (tshow)
import Text.Pandoc.Writers.Shared (lookupMetaInlines, lookupMetaBlocks
@@ -193,7 +192,7 @@ data DocProps = DocProps { dcTitle :: Maybe T.Text
, dcKeywords :: Maybe [T.Text]
, dcDescription :: Maybe T.Text
, cpCategory :: Maybe T.Text
- , dcCreated :: Maybe UTCTime
+ , dcDate :: Maybe T.Text
, customProperties :: Maybe [(T.Text, T.Text)]
} deriving (Show, Eq)
@@ -1149,7 +1148,11 @@ metaToDocProps meta =
, dcKeywords = keywords
, dcDescription = description
, cpCategory = Shared.stringify <$> lookupMeta "category" meta
- , dcCreated = Nothing
+ , dcDate =
+ let t = Shared.stringify (docDate meta)
+ in if T.null t
+ then Nothing
+ else Just t
, customProperties = customProperties'
}