@@ -58,7 +58,7 @@ import Text.Pandoc.MIME
5858import qualified Data.ByteString.Lazy as BL
5959import Text.Pandoc.Writers.OOXML
6060import qualified Data.Map as M
61−import Data.Maybe (mapMaybe, listToMaybe, fromMaybe, maybeToList, catMaybes)
61+import Data.Maybe (mapMaybe, listToMaybe, fromMaybe, maybeToList, catMaybes, isNothing)
6262import Text.Pandoc.ImageSize
6363import Control.Applicative ((<|>))
6464import System.FilePath.Glob
@@ -252,6 +252,8 @@ presentationToArchiveP p@(Presentation docProps slides) = do
252252 newArch' <- foldM copyFileToArchive emptyArchive filePaths
253253 -- we make a docProps/core.xml entry out of the presentation docprops
254254 docPropsEntry <- docPropsToEntry docProps
255+ -- we make a docProps/custom.xml entry out of the custom properties
256+ docCustomPropsEntry <- docCustomPropsToEntry docProps
255257 -- we make this ourself in case there's something unexpected in the
256258 -- one in the reference doc.
257259 relsEntry <- topLevelRelsEntry
@@ -274,7 +276,8 @@ presentationToArchiveP p@(Presentation docProps slides) = do
274276 spkNotesEntries ++
275277 spkNotesRelEntries ++
276278 mediaEntries ++
277− [contentTypesEntry, docPropsEntry, relsEntry, presEntry, presRelsEntry]
279+ [contentTypesEntry, docPropsEntry, docCustomPropsEntry, relsEntry,
280+ presEntry, presRelsEntry]
278281
279282makeSlideIdMap :: Presentation -> M.Map SlideId Int
280283makeSlideIdMap (Presentation _ slides) =
@@ -1425,6 +1428,10 @@ topLevelRels =
14251428 , relType = "http://schemas.openxmlformats.org/package/2006/relationships/metadata/extended-properties"
14261429 , relTarget = "docProps/app.xml"
14271430 }
1431+ , Relationship { relId = 4
1432+ , relType = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/custom-properties"
1433+ , relTarget = "docProps/custom.xml"
1434+ }
14281435 ]
14291436
14301437topLevelRelsEntry :: PandocMonad m => P m Entry
@@ -1657,7 +1664,7 @@ docPropsElement :: PandocMonad m => DocProps -> P m Element
16571664docPropsElement docProps = do
16581665 utctime <- asks envUTCTime
16591666 let keywords = case dcKeywords docProps of
1660− Just xs -> intercalate "," xs
1667+ Just xs -> intercalate ", " xs
16611668 Nothing -> ""
16621669 return $
16631670 mknode "cp:coreProperties"
@@ -1669,7 +1676,13 @@ docPropsElement docProps = do
16691676 $ (mknode "dc:title" [] $ fromMaybe "" $ dcTitle docProps)
16701677 : (mknode "dc:creator" [] $ fromMaybe "" $ dcCreator docProps)
16711678 : (mknode "cp:keywords" [] keywords)
1672− : (\x -> [ mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] x
1679+ : (if isNothing (dcSubject docProps) then [] else
1680+ [mknode "dc:subject" [] $ fromMaybe "" $ dcSubject docProps])
1681+ ++ (if isNothing (dcDescription docProps) then [] else
1682+ [mknode "dc:description" [] $ fromMaybe "" $ dcDescription docProps])
1683+ ++ (if isNothing (cpCategory docProps) then [] else
1684+ [mknode "cp:category" [] $ fromMaybe "" $ cpCategory docProps])
1685+ ++ (\x -> [ mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] x
16731686 , mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] x
16741687 ]) (formatTime defaultTimeLocale "%FT%XZ" utctime)
16751688
@@ -1677,6 +1690,21 @@ docPropsToEntry :: PandocMonad m => DocProps -> P m Entry
16771690docPropsToEntry docProps = docPropsElement docProps >>=
16781691 elemToEntry "docProps/core.xml"
16791692
1693+-- adapted from the Docx writer
1694+docCustomPropsElement :: PandocMonad m => DocProps -> P m Element
1695+docCustomPropsElement docProps = do
1696+ let mkCustomProp (k, v) pid = mknode "property"
1697+ [("fmtid","{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
1698+ ,("pid", show pid)
1699+ ,("name", k)] $ mknode "vt:lpwstr" [] v
1700+ return $ mknode "Properties"
1701+ [("xmlns","http://schemas.openxmlformats.org/officeDocument/2006/custom-properties")
1702+ ,("xmlns:vt","http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes")
1703+ ] $ zipWith mkCustomProp (fromMaybe [] $ customProperties docProps) [(2 :: Int)..]
1704+
1705+docCustomPropsToEntry :: PandocMonad m => DocProps -> P m Entry
1706+docCustomPropsToEntry docProps = docCustomPropsElement docProps >>=
1707+ elemToEntry "docProps/custom.xml"
16801708
16811709defaultContentTypeToElem :: DefaultContentType -> Element
16821710defaultContentTypeToElem dct =
@@ -1765,6 +1793,7 @@ presentationToContentTypes p@(Presentation _ slides) = do
17651793
17661794 inheritedOverrides = mapMaybe pathToOverride filePaths
17671795 docPropsOverride = mapMaybe pathToOverride ["docProps/core.xml"]
1796+ docCustomPropsOverride = mapMaybe pathToOverride ["docProps/custom.xml"]
17681797 presOverride = mapMaybe pathToOverride ["ppt/presentation.xml"]
17691798 relativePaths <- mapM slideToFilePath slides
17701799 let slideOverrides = mapMaybe
@@ -1773,7 +1802,8 @@ presentationToContentTypes p@(Presentation _ slides) = do
17731802 speakerNotesOverrides <- (mapMaybe pathToOverride) <$> getSpeakerNotesFilePaths
17741803 return $ ContentTypes
17751804 (defaults ++ mediaDefaults)
1776− (inheritedOverrides ++ docPropsOverride ++ presOverride ++ slideOverrides ++ speakerNotesOverrides)
1805+ (inheritedOverrides ++ docPropsOverride ++ docCustomPropsOverride ++
1806+ presOverride ++ slideOverrides ++ speakerNotesOverrides)
17771807
17781808presML :: String
17791809presML = "application/vnd.openxmlformats-officedocument.presentationml"
@@ -1788,6 +1818,7 @@ getContentType fp
17881818 | fp == "ppt/viewProps.xml" = Just $ presML ++ ".viewProps+xml"
17891819 | fp == "ppt/tableStyles.xml" = Just $ presML ++ ".tableStyles+xml"
17901820 | fp == "docProps/core.xml" = Just $ "application/vnd.openxmlformats-package.core-properties+xml"
1821+ | fp == "docProps/custom.xml" = Just $ "application/vnd.openxmlformats-officedocument.custom-properties+xml"
17911822 | fp == "docProps/app.xml" = Just $ noPresML ++ ".extended-properties+xml"
17921823 | "ppt" : "slideMasters" : f : [] <- splitDirectories fp
17931824 , (_, ".xml") <- splitExtension f =