Powerpoint writer: Read speaker note templates conditionally

If there are speaker notes in the presentation, we read in the
notesMasters templates from the reference pptx file.
This commit is contained in:
Jesse Rosenthal 2018-02-17 10:01:12 -05:00
parent 6c6ac9f22e
commit eace2357dd

View file

@ -56,7 +56,7 @@ import Text.Pandoc.MIME
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import Text.Pandoc.Writers.OOXML import Text.Pandoc.Writers.OOXML
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (mapMaybe, listToMaybe, fromMaybe) import Data.Maybe (mapMaybe, listToMaybe, fromMaybe, isJust)
import Text.Pandoc.ImageSize import Text.Pandoc.ImageSize
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import System.FilePath.Glob import System.FilePath.Glob
@ -167,8 +167,9 @@ copyFileToArchive arch fp = do
Nothing -> fail $ fp ++ " missing in reference file" Nothing -> fail $ fp ++ " missing in reference file"
Just e -> return $ addEntryToArchive e arch Just e -> return $ addEntryToArchive e arch
inheritedPatterns :: [Pattern] alwaysInheritedPatterns :: [Pattern]
inheritedPatterns = map compile [ "docProps/app.xml" alwaysInheritedPatterns =
map compile [ "docProps/app.xml"
, "ppt/slideLayouts/slideLayout*.xml" , "ppt/slideLayouts/slideLayout*.xml"
, "ppt/slideLayouts/_rels/slideLayout*.xml.rels" , "ppt/slideLayouts/_rels/slideLayout*.xml.rels"
, "ppt/slideMasters/slideMaster1.xml" , "ppt/slideMasters/slideMaster1.xml"
@ -181,6 +182,21 @@ inheritedPatterns = map compile [ "docProps/app.xml"
, "ppt/media/image*" , "ppt/media/image*"
] ]
-- We only look for these under special conditions
contingentInheritedPatterns :: Presentation -> [Pattern]
contingentInheritedPatterns pres = [] ++
if hasSpeakerNotes pres
then map compile [ "ppt/notesMasters/notesMaster*.xml"
, "ppt/notesMasters/_rels/notesMaster*.xml.rels"
, "ppt/theme/theme2.xml"
, "ppt/theme/_rels/theme2.xml.rels"
]
else []
inheritedPatterns :: Presentation -> [Pattern]
inheritedPatterns pres =
alwaysInheritedPatterns ++ contingentInheritedPatterns pres
patternToFilePaths :: PandocMonad m => Pattern -> P m [FilePath] patternToFilePaths :: PandocMonad m => Pattern -> P m [FilePath]
patternToFilePaths pat = do patternToFilePaths pat = do
refArchive <- asks envRefArchive refArchive <- asks envRefArchive
@ -212,10 +228,9 @@ requiredFiles = [ "docProps/app.xml"
, "ppt/tableStyles.xml" , "ppt/tableStyles.xml"
] ]
presentationToArchiveP :: PandocMonad m => Presentation -> P m Archive presentationToArchiveP :: PandocMonad m => Presentation -> P m Archive
presentationToArchiveP p@(Presentation docProps slides) = do presentationToArchiveP p@(Presentation docProps slides) = do
filePaths <- patternsToFilePaths inheritedPatterns filePaths <- patternsToFilePaths $ inheritedPatterns p
-- make sure all required files are available: -- make sure all required files are available:
let missingFiles = filter (\fp -> not (fp `elem` filePaths)) requiredFiles let missingFiles = filter (\fp -> not (fp `elem` filePaths)) requiredFiles
@ -287,6 +302,11 @@ presentationToArchive opts pres = do
-------------------------------------------------- --------------------------------------------------
-- Check to see if the presentation has speaker notes. This will
-- influence whether we import the notesMaster template.
hasSpeakerNotes :: Presentation -> Bool
hasSpeakerNotes (Presentation _ slides) = any isJust $ map slideSpeakerNotes slides
-------------------------------------------------- --------------------------------------------------
getLayout :: PandocMonad m => Layout -> P m Element getLayout :: PandocMonad m => Layout -> P m Element
@ -1422,9 +1442,9 @@ mediaContentType mInfo
| otherwise = Nothing | otherwise = Nothing
presentationToContentTypes :: PandocMonad m => Presentation -> P m ContentTypes presentationToContentTypes :: PandocMonad m => Presentation -> P m ContentTypes
presentationToContentTypes (Presentation _ slides) = do presentationToContentTypes p@(Presentation _ slides) = do
mediaInfos <- (mconcat . M.elems) <$> gets stMediaIds mediaInfos <- (mconcat . M.elems) <$> gets stMediaIds
filePaths <- patternsToFilePaths inheritedPatterns filePaths <- patternsToFilePaths $ inheritedPatterns p
let mediaFps = filter (match (compile "ppt/media/image*")) filePaths let mediaFps = filter (match (compile "ppt/media/image*")) filePaths
let defaults = [ DefaultContentType "xml" "application/xml" let defaults = [ DefaultContentType "xml" "application/xml"
, DefaultContentType "rels" "application/vnd.openxmlformats-package.relationships+xml" , DefaultContentType "rels" "application/vnd.openxmlformats-package.relationships+xml"