diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/Powerpoint')
| -rw-r--r-- | src/Text/Pandoc/Writers/Powerpoint/Output.hs | 41 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Powerpoint/Presentation.hs | 21 |
2 files changed, 55 insertions, 7 deletions
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs index 3e6652686..7ab50b8c4 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs @@ -58,7 +58,7 @@ import Text.Pandoc.MIME import qualified Data.ByteString.Lazy as BL import Text.Pandoc.Writers.OOXML import qualified Data.Map as M -import Data.Maybe (mapMaybe, listToMaybe, fromMaybe, maybeToList, catMaybes) +import Data.Maybe (mapMaybe, listToMaybe, fromMaybe, maybeToList, catMaybes, isNothing) import Text.Pandoc.ImageSize import Control.Applicative ((<|>)) import System.FilePath.Glob @@ -252,6 +252,8 @@ presentationToArchiveP p@(Presentation docProps slides) = do newArch' <- foldM copyFileToArchive emptyArchive filePaths -- we make a docProps/core.xml entry out of the presentation docprops docPropsEntry <- docPropsToEntry docProps + -- we make a docProps/custom.xml entry out of the custom properties + docCustomPropsEntry <- docCustomPropsToEntry docProps -- we make this ourself in case there's something unexpected in the -- one in the reference doc. relsEntry <- topLevelRelsEntry @@ -274,7 +276,8 @@ presentationToArchiveP p@(Presentation docProps slides) = do spkNotesEntries ++ spkNotesRelEntries ++ mediaEntries ++ - [contentTypesEntry, docPropsEntry, relsEntry, presEntry, presRelsEntry] + [contentTypesEntry, docPropsEntry, docCustomPropsEntry, relsEntry, + presEntry, presRelsEntry] makeSlideIdMap :: Presentation -> M.Map SlideId Int makeSlideIdMap (Presentation _ slides) = @@ -1425,6 +1428,10 @@ topLevelRels = , relType = "http://schemas.openxmlformats.org/package/2006/relationships/metadata/extended-properties" , relTarget = "docProps/app.xml" } + , Relationship { relId = 4 + , relType = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/custom-properties" + , relTarget = "docProps/custom.xml" + } ] topLevelRelsEntry :: PandocMonad m => P m Entry @@ -1657,7 +1664,7 @@ docPropsElement :: PandocMonad m => DocProps -> P m Element docPropsElement docProps = do utctime <- asks envUTCTime let keywords = case dcKeywords docProps of - Just xs -> intercalate "," xs + Just xs -> intercalate ", " xs Nothing -> "" return $ mknode "cp:coreProperties" @@ -1669,7 +1676,13 @@ docPropsElement docProps = do $ (mknode "dc:title" [] $ fromMaybe "" $ dcTitle docProps) : (mknode "dc:creator" [] $ fromMaybe "" $ dcCreator docProps) : (mknode "cp:keywords" [] keywords) - : (\x -> [ mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] x + : (if isNothing (dcSubject docProps) then [] else + [mknode "dc:subject" [] $ fromMaybe "" $ dcSubject docProps]) + ++ (if isNothing (dcDescription docProps) then [] else + [mknode "dc:description" [] $ fromMaybe "" $ dcDescription docProps]) + ++ (if isNothing (cpCategory docProps) then [] else + [mknode "cp:category" [] $ fromMaybe "" $ cpCategory docProps]) + ++ (\x -> [ mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] x , mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] x ]) (formatTime defaultTimeLocale "%FT%XZ" utctime) @@ -1677,6 +1690,21 @@ docPropsToEntry :: PandocMonad m => DocProps -> P m Entry docPropsToEntry docProps = docPropsElement docProps >>= elemToEntry "docProps/core.xml" +-- adapted from the Docx writer +docCustomPropsElement :: PandocMonad m => DocProps -> P m Element +docCustomPropsElement docProps = do + let mkCustomProp (k, v) pid = mknode "property" + [("fmtid","{D5CDD505-2E9C-101B-9397-08002B2CF9AE}") + ,("pid", show pid) + ,("name", k)] $ mknode "vt:lpwstr" [] v + return $ mknode "Properties" + [("xmlns","http://schemas.openxmlformats.org/officeDocument/2006/custom-properties") + ,("xmlns:vt","http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes") + ] $ zipWith mkCustomProp (fromMaybe [] $ customProperties docProps) [(2 :: Int)..] + +docCustomPropsToEntry :: PandocMonad m => DocProps -> P m Entry +docCustomPropsToEntry docProps = docCustomPropsElement docProps >>= + elemToEntry "docProps/custom.xml" defaultContentTypeToElem :: DefaultContentType -> Element defaultContentTypeToElem dct = @@ -1765,6 +1793,7 @@ presentationToContentTypes p@(Presentation _ slides) = do inheritedOverrides = mapMaybe pathToOverride filePaths docPropsOverride = mapMaybe pathToOverride ["docProps/core.xml"] + docCustomPropsOverride = mapMaybe pathToOverride ["docProps/custom.xml"] presOverride = mapMaybe pathToOverride ["ppt/presentation.xml"] relativePaths <- mapM slideToFilePath slides let slideOverrides = mapMaybe @@ -1773,7 +1802,8 @@ presentationToContentTypes p@(Presentation _ slides) = do speakerNotesOverrides <- (mapMaybe pathToOverride) <$> getSpeakerNotesFilePaths return $ ContentTypes (defaults ++ mediaDefaults) - (inheritedOverrides ++ docPropsOverride ++ presOverride ++ slideOverrides ++ speakerNotesOverrides) + (inheritedOverrides ++ docPropsOverride ++ docCustomPropsOverride ++ + presOverride ++ slideOverrides ++ speakerNotesOverrides) presML :: String presML = "application/vnd.openxmlformats-officedocument.presentationml" @@ -1788,6 +1818,7 @@ getContentType fp | fp == "ppt/viewProps.xml" = Just $ presML ++ ".viewProps+xml" | fp == "ppt/tableStyles.xml" = Just $ presML ++ ".tableStyles+xml" | fp == "docProps/core.xml" = Just $ "application/vnd.openxmlformats-package.core-properties+xml" + | fp == "docProps/custom.xml" = Just $ "application/vnd.openxmlformats-officedocument.custom-properties+xml" | fp == "docProps/app.xml" = Just $ noPresML ++ ".extended-properties+xml" | "ppt" : "slideMasters" : f : [] <- splitDirectories fp , (_, ".xml") <- splitExtension f = diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs index 7897f2b11..fee1a0f6e 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs @@ -72,7 +72,8 @@ 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.Writers.Shared (lookupMetaInlines, toTableOfContents) +import Text.Pandoc.Writers.Shared (lookupMetaInlines, lookupMetaBlocks + , lookupMetaString, toTableOfContents) import qualified Data.Map as M import qualified Data.Set as S import Data.Maybe (maybeToList, fromMaybe) @@ -180,7 +181,10 @@ data DocProps = DocProps { dcTitle :: Maybe String , dcSubject :: Maybe String , dcCreator :: Maybe String , dcKeywords :: Maybe [String] + , dcDescription :: Maybe String + , cpCategory :: Maybe String , dcCreated :: Maybe UTCTime + , customProperties :: Maybe [(String, String)] } deriving (Show, Eq) @@ -930,13 +934,26 @@ metaToDocProps meta = authors = case map Shared.stringify $ docAuthors meta of [] -> Nothing - ss -> Just $ intercalate ";" ss + ss -> Just $ intercalate "; " ss + + description = case map Shared.stringify $ lookupMetaBlocks "description" meta of + [] -> Nothing + ss -> Just $ intercalate "_x000d_\n" ss + + customProperties' = case [(k, lookupMetaString k meta) | k <- M.keys (unMeta meta) + , k `notElem` (["title", "author", "keywords", "description" + , "subject","lang","category"])] of + [] -> Nothing + ss -> Just ss in DocProps{ dcTitle = Shared.stringify <$> lookupMeta "title" meta , dcSubject = Shared.stringify <$> lookupMeta "subject" meta , dcCreator = authors , dcKeywords = keywords + , dcDescription = description + , cpCategory = Shared.stringify <$> lookupMeta "category" meta , dcCreated = Nothing + , customProperties = customProperties' } documentToPresentation :: WriterOptions |