@@ -40,6 +40,7 @@ import Control.Monad.State
4040import Codec.Archive.Zip
4141import Data.List (intercalate, stripPrefix, nub, union, isPrefixOf)
4242import Data.Default
43+import Text.Pandoc.Compat.Time (formatTime, defaultTimeLocale)
4344import Data.Time.Clock (UTCTime)
4445import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime)
4546import System.FilePath.Posix (splitDirectories, splitExtension, takeExtension)
@@ -54,7 +55,7 @@ import Text.Pandoc.MIME
5455import qualified Data.ByteString.Lazy as BL
5556import Text.Pandoc.Writers.OOXML
5657import qualified Data.Map as M
57−import Data.Maybe (mapMaybe, listToMaybe)
58+import Data.Maybe (mapMaybe, listToMaybe, fromMaybe)
5859import Text.Pandoc.ImageSize
5960import Control.Applicative ((<|>))
6061import System.FilePath.Glob
@@ -166,7 +167,6 @@ copyFileToArchive arch fp = do
166167
167168inheritedPatterns :: [Pattern]
168169inheritedPatterns = map compile [ "docProps/app.xml"
169− , "docProps/core.xml"
170170 , "ppt/slideLayouts/slideLayout*.xml"
171171 , "ppt/slideLayouts/_rels/slideLayout*.xml.rels"
172172 , "ppt/slideMasters/slideMaster1.xml"
@@ -194,7 +194,6 @@ patternsToFilePaths pats = concat <$> mapM patternToFilePaths pats
194194-- any of these are missing, we should error out of our build.
195195requiredFiles :: [FilePath]
196196requiredFiles = [ "docProps/app.xml"
197− , "docProps/core.xml"
198197 , "ppt/presProps.xml"
199198 , "ppt/slideLayouts/slideLayout1.xml"
200199 , "ppt/slideLayouts/_rels/slideLayout1.xml.rels"
@@ -213,7 +212,7 @@ requiredFiles = [ "docProps/app.xml"
213212
214213
215214presentationToArchiveP :: PandocMonad m => Presentation -> P m Archive
216−presentationToArchiveP p@(Presentation _ slides) = do
215+presentationToArchiveP p@(Presentation docProps slides) = do
217216 filePaths <- patternsToFilePaths inheritedPatterns
218217
219218 -- make sure all required files are available:
@@ -226,6 +225,8 @@ presentationToArchiveP p@(Presentation _ slides) = do
226225 )
227226
228227 newArch' <- foldM copyFileToArchive emptyArchive filePaths
228+ -- we make a docProps/core.xml entry out of the presentation docprops
229+ docPropsEntry <- docPropsToEntry docProps
229230 -- we make this ourself in case there's something unexpected in the
230231 -- one in the reference doc.
231232 relsEntry <- topLevelRelsEntry
@@ -244,7 +245,7 @@ presentationToArchiveP p@(Presentation _ slides) = do
244245 slideEntries ++
245246 slideRelEntries ++
246247 mediaEntries ++
247− [contentTypesEntry, relsEntry, presEntry, presRelsEntry]
248+ [contentTypesEntry, docPropsEntry, relsEntry, presEntry, presRelsEntry]
248249
249250makeSlideIdMap :: Presentation -> M.Map SlideId Int
250251makeSlideIdMap (Presentation _ slides) =
@@ -1313,7 +1314,30 @@ presentationToPresEntry :: PandocMonad m => Presentation -> P m Entry
13131314presentationToPresEntry pres = presentationToPresentationElement pres >>=
13141315 elemToEntry "ppt/presentation.xml"
13151316
1316−
1317+-- adapted from the Docx writer
1318+docPropsElement :: PandocMonad m => DocProps -> P m Element
1319+docPropsElement docProps = do
1320+ utctime <- asks envUTCTime
1321+ let keywords = case dcKeywords docProps of
1322+ Just xs -> intercalate "," xs
1323+ Nothing -> ""
1324+ return $
1325+ mknode "cp:coreProperties"
1326+ [("xmlns:cp","http://schemas.openxmlformats.org/package/2006/metadata/core-properties")
1327+ ,("xmlns:dc","http://purl.org/dc/elements/1.1/")
1328+ ,("xmlns:dcterms","http://purl.org/dc/terms/")
1329+ ,("xmlns:dcmitype","http://purl.org/dc/dcmitype/")
1330+ ,("xmlns:xsi","http://www.w3.org/2001/XMLSchema-instance")]
1331+ $ (mknode "dc:title" [] $ fromMaybe "" $ dcTitle docProps)
1332+ : (mknode "dc:creator" [] $ fromMaybe "" $ dcCreator docProps)
1333+ : (mknode "cp:keywords" [] keywords)
1334+ : (\x -> [ mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] x
1335+ , mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] x
1336+ ]) (formatTime defaultTimeLocale "%FT%XZ" utctime)
1337+
1338+docPropsToEntry :: PandocMonad m => DocProps -> P m Entry
1339+docPropsToEntry docProps = docPropsElement docProps >>=
1340+ elemToEntry "docProps/core.xml"
13171341
13181342
13191343defaultContentTypeToElem :: DefaultContentType -> Element
@@ -1396,6 +1420,7 @@ presentationToContentTypes (Presentation _ slides) = do
13961420 (mapMaybe mediaFileContentType $ mediaFps)
13971421
13981422 inheritedOverrides = mapMaybe pathToOverride filePaths
1423+ docPropsOverride = mapMaybe pathToOverride ["docProps/core.xml"]
13991424 presOverride = mapMaybe pathToOverride ["ppt/presentation.xml"]
14001425 relativePaths <- mapM slideToFilePath slides
14011426 let slideOverrides = mapMaybe
@@ -1403,7 +1428,7 @@ presentationToContentTypes (Presentation _ slides) = do
14031428 relativePaths
14041429 return $ ContentTypes
14051430 (defaults ++ mediaDefaults)
1406− (inheritedOverrides ++ presOverride ++ slideOverrides)
1431+ (inheritedOverrides ++ docPropsOverride ++ presOverride ++ slideOverrides)
14071432
14081433presML :: String
14091434presML = "application/vnd.openxmlformats-officedocument.presentationml"