aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers
diff options
context:
space:
mode:
authorJesse Rosenthal <jrosenthal@jhu.edu>2018-01-18 09:41:16 -0500
committerJesse Rosenthal <jrosenthal@jhu.edu>2018-01-18 10:15:17 -0500
commiteae790485325ba6993b29d7b3ad638fefb1d21ee (patch)
treec0fc942b0c714532737c482e6bb622973fa0e6c1 /src/Text/Pandoc/Writers
parentbfef2cbbf33ac1ebc2a1b90a78a9598b3bc76169 (diff)
downloadpandoc-eae790485325ba6993b29d7b3ad638fefb1d21ee.tar.gz
Powerpoint writer: Make our own docProps/core.xml file.
This allows us to set document metadata properties from pandoc metadata.
Diffstat (limited to 'src/Text/Pandoc/Writers')
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Output.hs39
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Presentation.hs9
2 files changed, 37 insertions, 11 deletions
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
index 45ae86352..f0485adcc 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
@@ -40,6 +40,7 @@ import Control.Monad.State
import Codec.Archive.Zip
import Data.List (intercalate, stripPrefix, nub, union, isPrefixOf)
import Data.Default
+import Text.Pandoc.Compat.Time (formatTime, defaultTimeLocale)
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime)
import System.FilePath.Posix (splitDirectories, splitExtension, takeExtension)
@@ -54,7 +55,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)
+import Data.Maybe (mapMaybe, listToMaybe, fromMaybe)
import Text.Pandoc.ImageSize
import Control.Applicative ((<|>))
import System.FilePath.Glob
@@ -166,7 +167,6 @@ copyFileToArchive arch fp = do
inheritedPatterns :: [Pattern]
inheritedPatterns = map compile [ "docProps/app.xml"
- , "docProps/core.xml"
, "ppt/slideLayouts/slideLayout*.xml"
, "ppt/slideLayouts/_rels/slideLayout*.xml.rels"
, "ppt/slideMasters/slideMaster1.xml"
@@ -194,7 +194,6 @@ patternsToFilePaths pats = concat <$> mapM patternToFilePaths pats
-- any of these are missing, we should error out of our build.
requiredFiles :: [FilePath]
requiredFiles = [ "docProps/app.xml"
- , "docProps/core.xml"
, "ppt/presProps.xml"
, "ppt/slideLayouts/slideLayout1.xml"
, "ppt/slideLayouts/_rels/slideLayout1.xml.rels"
@@ -213,7 +212,7 @@ requiredFiles = [ "docProps/app.xml"
presentationToArchiveP :: PandocMonad m => Presentation -> P m Archive
-presentationToArchiveP p@(Presentation _ slides) = do
+presentationToArchiveP p@(Presentation docProps slides) = do
filePaths <- patternsToFilePaths inheritedPatterns
-- make sure all required files are available:
@@ -226,6 +225,8 @@ presentationToArchiveP p@(Presentation _ slides) = do
)
newArch' <- foldM copyFileToArchive emptyArchive filePaths
+ -- we make a docProps/core.xml entry out of the presentation docprops
+ docPropsEntry <- docPropsToEntry docProps
-- we make this ourself in case there's something unexpected in the
-- one in the reference doc.
relsEntry <- topLevelRelsEntry
@@ -244,7 +245,7 @@ presentationToArchiveP p@(Presentation _ slides) = do
slideEntries ++
slideRelEntries ++
mediaEntries ++
- [contentTypesEntry, relsEntry, presEntry, presRelsEntry]
+ [contentTypesEntry, docPropsEntry, relsEntry, presEntry, presRelsEntry]
makeSlideIdMap :: Presentation -> M.Map SlideId Int
makeSlideIdMap (Presentation _ slides) =
@@ -1313,7 +1314,30 @@ presentationToPresEntry :: PandocMonad m => Presentation -> P m Entry
presentationToPresEntry pres = presentationToPresentationElement pres >>=
elemToEntry "ppt/presentation.xml"
-
+-- adapted from the Docx writer
+docPropsElement :: PandocMonad m => DocProps -> P m Element
+docPropsElement docProps = do
+ utctime <- asks envUTCTime
+ let keywords = case dcKeywords docProps of
+ Just xs -> intercalate "," xs
+ Nothing -> ""
+ return $
+ mknode "cp:coreProperties"
+ [("xmlns:cp","http://schemas.openxmlformats.org/package/2006/metadata/core-properties")
+ ,("xmlns:dc","http://purl.org/dc/elements/1.1/")
+ ,("xmlns:dcterms","http://purl.org/dc/terms/")
+ ,("xmlns:dcmitype","http://purl.org/dc/dcmitype/")
+ ,("xmlns:xsi","http://www.w3.org/2001/XMLSchema-instance")]
+ $ (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
+ , mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] x
+ ]) (formatTime defaultTimeLocale "%FT%XZ" utctime)
+
+docPropsToEntry :: PandocMonad m => DocProps -> P m Entry
+docPropsToEntry docProps = docPropsElement docProps >>=
+ elemToEntry "docProps/core.xml"
defaultContentTypeToElem :: DefaultContentType -> Element
@@ -1396,6 +1420,7 @@ presentationToContentTypes (Presentation _ slides) = do
(mapMaybe mediaFileContentType $ mediaFps)
inheritedOverrides = mapMaybe pathToOverride filePaths
+ docPropsOverride = mapMaybe pathToOverride ["docProps/core.xml"]
presOverride = mapMaybe pathToOverride ["ppt/presentation.xml"]
relativePaths <- mapM slideToFilePath slides
let slideOverrides = mapMaybe
@@ -1403,7 +1428,7 @@ presentationToContentTypes (Presentation _ slides) = do
relativePaths
return $ ContentTypes
(defaults ++ mediaDefaults)
- (inheritedOverrides ++ presOverride ++ slideOverrides)
+ (inheritedOverrides ++ docPropsOverride ++ presOverride ++ slideOverrides)
presML :: String
presML = "application/vnd.openxmlformats-officedocument.presentationml"
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
index 1300bbe39..e1192745f 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
@@ -34,6 +34,7 @@ Presentation.
module Text.Pandoc.Writers.Powerpoint.Presentation ( documentToPresentation
, Presentation(..)
+ , DocProps(..)
, Slide(..)
, Layout(..)
, Notes(..)
@@ -852,13 +853,13 @@ metaToDocProps meta =
Just (MetaList xs) -> Just $ map Shared.stringify xs
_ -> Nothing
- authors = case lookupMeta "author" meta of
- Just (MetaList xs) -> Just $ map Shared.stringify xs
- _ -> Nothing
+ authors = case map Shared.stringify $ docAuthors meta of
+ [] -> Nothing
+ ss -> Just $ intercalate ";" ss
in
DocProps{ dcTitle = Shared.stringify <$> lookupMeta "title" meta
, dcSubject = Shared.stringify <$> lookupMeta "subject" meta
- , dcCreator = (intercalate "; ") <$> authors
+ , dcCreator = authors
, dcKeywords = keywords
, dcCreated = Nothing
}