@@ -56,7 +56,7 @@ import Text.Pandoc.MIME
5656import qualified Data.ByteString.Lazy as BL
5757import Text.Pandoc.Writers.OOXML
5858import qualified Data.Map as M
59−import Data.Maybe (mapMaybe, listToMaybe, fromMaybe, isJust)
59+import Data.Maybe (mapMaybe, listToMaybe, fromMaybe, isJust, maybeToList, catMaybes)
6060import Text.Pandoc.ImageSize
6161import Control.Applicative ((<|>))
6262import System.FilePath.Glob
@@ -109,6 +109,11 @@ data WriterEnv = WriterEnv { envRefArchive :: Archive
109109 , envSlideIdOffset :: Int
110110 , envContentType :: ContentType
111111 , envSlideIdMap :: M.Map SlideId Int
112+ -- maps the slide number to the
113+ -- corresponding notes id number. If there
114+ -- are no notes for a slide, there will be
115+ -- no entry in the map for it.
116+ , envSpeakerNotesIdMap :: M.Map Int Int
112117 }
113118 deriving (Show)
114119
@@ -125,6 +130,7 @@ instance Default WriterEnv where
125130 , envSlideIdOffset = 1
126131 , envContentType = NormalContent
127132 , envSlideIdMap = mempty
133+ , envSpeakerNotesIdMap = mempty
128134 }
129135
130136data ContentType = NormalContent
@@ -185,7 +191,7 @@ alwaysInheritedPatterns =
185191-- We only look for these under special conditions
186192contingentInheritedPatterns :: Presentation -> [Pattern]
187193contingentInheritedPatterns pres = [] ++
188− if hasSpeakerNotes pres
194+ if presHasSpeakerNotes pres
189195 then map compile [ "ppt/notesMasters/notesMaster*.xml"
190196 , "ppt/notesMasters/_rels/notesMaster*.xml.rels"
191197 , "ppt/theme/theme2.xml"
@@ -253,6 +259,8 @@ presentationToArchiveP p@(Presentation docProps slides) = do
253259 presRelsEntry <- presentationToRelsEntry p
254260 slideEntries <- mapM slideToEntry slides
255261 slideRelEntries <- mapM slideToSlideRelEntry slides
262+ spkNotesEntries <- catMaybes <$> mapM slideToSpeakerNotesEntry slides
263+ spkNotesRelEntries <- catMaybes <$> mapM slideToSpeakerNotesRelEntry slides
256264 -- These have to come after everything, because they need the info
257265 -- built up in the state.
258266 mediaEntries <- makeMediaEntries
@@ -261,6 +269,8 @@ presentationToArchiveP p@(Presentation docProps slides) = do
261269 return $ foldr addEntryToArchive newArch' $
262270 slideEntries ++
263271 slideRelEntries ++
272+ spkNotesEntries ++
273+ spkNotesRelEntries ++
264274 mediaEntries ++
265275 [contentTypesEntry, docPropsEntry, relsEntry, presEntry, presRelsEntry]
266276
@@ -268,6 +278,12 @@ makeSlideIdMap :: Presentation -> M.Map SlideId Int
268278makeSlideIdMap (Presentation _ slides) =
269279 M.fromList $ (map slideId slides) `zip` [1..]
270280
281+makeSpeakerNotesMap :: Presentation -> M.Map Int Int
282+makeSpeakerNotesMap (Presentation _ slides) =
283+ M.fromList $ (mapMaybe f $ slides `zip` [1..]) `zip` [1..]
284+ where f (Slide _ _ Nothing, _) = Nothing
285+ f (Slide _ _ (Just _), n) = Just n
286+
271287presentationToArchive :: PandocMonad m => WriterOptions -> Presentation -> m Archive
272288presentationToArchive opts pres = do
273289 distArchive <- (toArchive . BL.fromStrict) <$>
@@ -291,6 +307,7 @@ presentationToArchive opts pres = do
291307 , envOpts = opts
292308 , envPresentationSize = presSize
293309 , envSlideIdMap = makeSlideIdMap pres
310+ , envSpeakerNotesIdMap = makeSpeakerNotesMap pres
294311 }
295312
296313 let st = def { stMediaGlobalIds = initialGlobalIds refArchive distArchive
@@ -304,8 +321,14 @@ presentationToArchive opts pres = do
304321
305322-- Check to see if the presentation has speaker notes. This will
306323-- influence whether we import the notesMaster template.
307−hasSpeakerNotes :: Presentation -> Bool
308−hasSpeakerNotes (Presentation _ slides) = any isJust $ map slideSpeakerNotes slides
324+presHasSpeakerNotes :: Presentation -> Bool
325+presHasSpeakerNotes (Presentation _ slides) = any isJust $ map slideSpeakerNotes slides
326+
327+curSlideHasSpeakerNotes :: PandocMonad m => P m Bool
328+curSlideHasSpeakerNotes = do
329+ sldId <- asks envCurSlideId
330+ notesIdMap <- asks envSpeakerNotesIdMap
331+ return $ isJust $ M.lookup sldId notesIdMap
309332
310333--------------------------------------------------
311334
@@ -448,15 +471,16 @@ registerLink link = do
448471 curSlideId <- asks envCurSlideId
449472 linkReg <- gets stLinkIds
450473 mediaReg <- gets stMediaIds
474+ hasSpeakerNotes <- curSlideHasSpeakerNotes
451475 let maxLinkId = case M.lookup curSlideId linkReg of
452476 Just mp -> case M.keys mp of
453− [] -> 1
477+ [] -> if hasSpeakerNotes then 2 else 1
454478 ks -> maximum ks
455− Nothing -> 1
479+ Nothing -> if hasSpeakerNotes then 2 else 1
456480 maxMediaId = case M.lookup curSlideId mediaReg of
457− Just [] -> 1
481+ Just [] -> if hasSpeakerNotes then 2 else 1
458482 Just mInfos -> maximum $ map mInfoLocalId mInfos
459− Nothing -> 1
483+ Nothing -> if hasSpeakerNotes then 2 else 1
460484 maxId = max maxLinkId maxMediaId
461485 slideLinks = case M.lookup curSlideId linkReg of
462486 Just mp -> M.insert (maxId + 1) link mp
@@ -470,15 +494,16 @@ registerMedia fp caption = do
470494 linkReg <- gets stLinkIds
471495 mediaReg <- gets stMediaIds
472496 globalIds <- gets stMediaGlobalIds
497+ hasSpeakerNotes <- curSlideHasSpeakerNotes
473498 let maxLinkId = case M.lookup curSlideId linkReg of
474499 Just mp -> case M.keys mp of
475− [] -> 1
500+ [] -> if hasSpeakerNotes then 2 else 1
476501 ks -> maximum ks
477− Nothing -> 1
502+ Nothing -> if hasSpeakerNotes then 2 else 1
478503 maxMediaId = case M.lookup curSlideId mediaReg of
479− Just [] -> 1
504+ Just [] -> if hasSpeakerNotes then 2 else 1
480505 Just mInfos -> maximum $ map mInfoLocalId mInfos
481− Nothing -> 1
506+ Nothing -> if hasSpeakerNotes then 2 else 1
482507 maxLocalId = max maxLinkId maxMediaId
483508
484509 maxGlobalId = case M.elems globalIds of
@@ -973,6 +998,21 @@ getShapeByName ns spTreeElem name
973998 filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns name e)) spTreeElem
974999 | otherwise = Nothing
9751000
1001+
1002+
1003+getShapeByPlaceHolderType :: NameSpaces -> Element -> String -> Maybe Element
1004+getShapeByPlaceHolderType ns spTreeElem phType
1005+ | isElem ns "p" "spTree" spTreeElem =
1006+ let findPhType element = isElem ns "p" "sp" element &&
1007+ Just phType == (Just element >>=
1008+ findChild (elemName ns "p" "nvSpPr") >>=
1009+ findChild (elemName ns "p" "nvPr") >>=
1010+ findChild (elemName ns "p" "ph") >>=
1011+ findAttr (QName "type" Nothing Nothing))
1012+ in
1013+ filterChild findPhType spTreeElem
1014+ | otherwise = Nothing
1015+
9761016-- getShapeById :: NameSpaces -> Element -> String -> Maybe Element
9771017-- getShapeById ns spTreeElem ident
9781018-- | isElem ns "p" "spTree" spTreeElem =
@@ -1109,6 +1149,148 @@ slideToElement (Slide _ l@(MetadataSlide titleElems subtitleElems authorElems da
11091149 ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
11101150 ] [mknode "p:cSld" [] [spTree]]
11111151
1152+
1153+--------------------------------------------------------------------
1154+-- Notes:
1155+
1156+getNotesMaster :: PandocMonad m => P m Element
1157+getNotesMaster = do
1158+ let notesMasterPath = "ppt/notesMasters/notesMaster1.xml"
1159+ distArchive <- asks envDistArchive
1160+ root <- case findEntryByPath notesMasterPath distArchive of
1161+ Just e -> case parseXMLDoc $ UTF8.toStringLazy $ fromEntry e of
1162+ Just element -> return $ element
1163+ Nothing -> throwError $
1164+ PandocSomeError $
1165+ notesMasterPath ++ " corrupt in reference file"
1166+ Nothing -> throwError $
1167+ PandocSomeError $
1168+ notesMasterPath ++ " missing in reference file"
1169+ return root
1170+
1171+getSlideNumberFieldId :: PandocMonad m => Element -> P m String
1172+getSlideNumberFieldId notesMaster
1173+ | ns <- elemToNameSpaces notesMaster
1174+ , Just cSld <- findChild (elemName ns "p" "cSld") notesMaster
1175+ , Just spTree <- findChild (elemName ns "p" "spTree") cSld
1176+ , Just sp <- getShapeByPlaceHolderType ns spTree "sldNum"
1177+ , Just txBody <- findChild (elemName ns "p" "txBody") sp
1178+ , Just p <- findChild (elemName ns "a" "p") txBody
1179+ , Just fld <- findChild (elemName ns "a" "fld") p
1180+ , Just fldId <- findAttr (QName "id" Nothing Nothing) fld =
1181+ return fldId
1182+ | otherwise = throwError $
1183+ PandocSomeError $
1184+ "No field id for slide numbers in notesMaster.xml"
1185+
1186+speakerNotesSlideImage :: Element
1187+speakerNotesSlideImage =
1188+ mknode "p:sp" [] $
1189+ [ mknode "p:nvSpPr" [] $
1190+ [ mknode "p:cNvPr" [ ("id", "2")
1191+ , ("name", "Slide Image Placeholder 1")
1192+ ] ()
1193+ , mknode "p:cNvSpPr" [] $
1194+ [ mknode "a:spLocks" [ ("noGrp", "1")
1195+ , ("noRot", "1")
1196+ , ("noChangeAspect", "1")
1197+ ] ()
1198+ ]
1199+ , mknode "p:nvPr" [] $
1200+ [ mknode "p:ph" [("type", "sldImg")] ()]
1201+ ]
1202+ , mknode "p:spPr" [] ()
1203+ ]
1204+
1205+speakerNotesBody :: PandocMonad m => [Paragraph] -> P m Element
1206+speakerNotesBody paras = do
1207+ elements <- mapM paragraphToElement paras
1208+ let txBody = mknode "p:txBody" [] $
1209+ [mknode "a:bodyPr" [] (), mknode "a:lstStyle" [] ()] ++ elements
1210+ return $
1211+ mknode "p:sp" [] $
1212+ [ mknode "p:nvSpPr" [] $
1213+ [ mknode "p:cNvPr" [ ("id", "3")
1214+ , ("name", "Notes Placeholder 2")
1215+ ] ()
1216+ , mknode "p:cNvSpPr" [] $
1217+ [ mknode "a:spLocks" [("noGrp", "1")] ()]
1218+ , mknode "p:nvPr" [] $
1219+ [ mknode "p:ph" [("type", "body"), ("idx", "1")] ()]
1220+ ]
1221+ , mknode "p:spPr" [] ()
1222+ , txBody
1223+ ]
1224+
1225+speakerNotesSlideNumber :: Int -> String -> Element
1226+speakerNotesSlideNumber pgNum fieldId =
1227+ mknode "p:sp" [] $
1228+ [ mknode "p:nvSpPr" [] $
1229+ [ mknode "p:cNvPr" [ ("id", "4")
1230+ , ("name", "Slide Number Placeholder 3")
1231+ ] ()
1232+ , mknode "p:cNvSpPr" [] $
1233+ [ mknode "a:spLocks" [("noGrp", "1")] ()]
1234+ , mknode "p:nvPr" [] $
1235+ [ mknode "p:ph" [ ("type", "sldNum")
1236+ , ("sz", "quarter")
1237+ , ("idx", "10")
1238+ ] ()
1239+ ]
1240+ ]
1241+ , mknode "p:spPr" [] ()
1242+ , mknode "p:txBody" [] $
1243+ [ mknode "a:bodyPr" [] ()
1244+ , mknode "a:lstStyle" [] ()
1245+ , mknode "a:p" [] $
1246+ [ mknode "a:fld" [ ("id", fieldId)
1247+ , ("type", "slidenum")
1248+ ]
1249+ [ mknode "a:rPr" [("lang", "en-US")] ()
1250+ , mknode "a:t" [] (show pgNum)
1251+ ]
1252+ , mknode "a:endParaRPr" [("lang", "en-US")] ()
1253+ ]
1254+ ]
1255+ ]
1256+
1257+slideToSpeakerNotesElement :: PandocMonad m => Slide -> P m (Maybe Element)
1258+slideToSpeakerNotesElement sld@(Slide _ _ mbNotes)
1259+ | Nothing <- mbNotes = return Nothing
1260+ | Just (SpeakerNotes paras) <- mbNotes = do
1261+ master <- getNotesMaster
1262+ fieldId <- getSlideNumberFieldId master
1263+ num <- slideNum sld
1264+ let imgShape = speakerNotesSlideImage
1265+ sldNumShape = speakerNotesSlideNumber num fieldId
1266+ bodyShape <- speakerNotesBody paras
1267+ return $ Just $
1268+ mknode "p:notes"
1269+ [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main")
1270+ , ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships")
1271+ , ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
1272+ ] [ mknode "p:cSld" []
1273+ [ mknode "p:spTree" []
1274+ [ mknode "p:nvGrpSpPr" []
1275+ [ mknode "p:cNvPr" [("id", "1"), ("name", "")] ()
1276+ , mknode "p:cNvGrpSpPr" [] ()
1277+ , mknode "p:nvPr" [] ()
1278+ ]
1279+ , mknode "p:grpSpPr" []
1280+ [ mknode "a:xfrm" []
1281+ [ mknode "a:off" [("x", "0"), ("y", "0")] ()
1282+ , mknode "a:ext" [("cx", "0"), ("cy", "0")] ()
1283+ , mknode "a:chOff" [("x", "0"), ("y", "0")] ()
1284+ , mknode "a:chExt" [("cx", "0"), ("cy", "0")] ()
1285+ ]
1286+ ]
1287+ , imgShape
1288+ , bodyShape
1289+ , sldNumShape
1290+ ]
1291+ ]
1292+ ]
1293+
11121294-----------------------------------------------------------------------
11131295
11141296getSlideIdNum :: PandocMonad m => SlideId -> P m Int
@@ -1252,6 +1434,53 @@ slideToEntry slide = do
12521434 element <- slideToElement slide
12531435 elemToEntry ("ppt/slides/" ++ idNumToFilePath idNum) element
12541436
1437+slideToSpeakerNotesEntry :: PandocMonad m => Slide -> P m (Maybe Entry)
1438+slideToSpeakerNotesEntry slide = do
1439+ idNum <- slideNum slide
1440+ local (\env -> env{envCurSlideId = idNum}) $ do
1441+ mbElement <- slideToSpeakerNotesElement slide
1442+ mbNotesIdNum <- do mp <- asks envSpeakerNotesIdMap
1443+ return $ M.lookup idNum mp
1444+ case mbElement of
1445+ Just element | Just notesIdNum <- mbNotesIdNum ->
1446+ Just <$>
1447+ elemToEntry
1448+ ("ppt/notesSlides/notesSlide" ++ show notesIdNum ++ ".xml")
1449+ element
1450+ _ -> return Nothing
1451+
1452+slideToSpeakerNotesRelElement :: PandocMonad m => Slide -> P m (Maybe Element)
1453+slideToSpeakerNotesRelElement slide@(Slide _ _ mbNotes)
1454+ | Nothing <- mbNotes = return Nothing
1455+ | Just _ <- mbNotes = do
1456+ idNum <- slideNum slide
1457+ return $ Just $
1458+ mknode "Relationships"
1459+ [("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")]
1460+ [ mknode "Relationship" [ ("Id", "rId2")
1461+ , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide")
1462+ , ("Target", "../slides/slide" ++ show idNum ++ ".xml")
1463+ ] ()
1464+ , mknode "Relationship" [ ("Id", "rId1")
1465+ , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesMaster")
1466+ , ("Target", "../notesMasters/notesMaster1.xml")
1467+ ] ()
1468+ ]
1469+
1470+slideToSpeakerNotesRelEntry :: PandocMonad m => Slide -> P m (Maybe Entry)
1471+slideToSpeakerNotesRelEntry slide = do
1472+ idNum <- slideNum slide
1473+ mbElement <- slideToSpeakerNotesRelElement slide
1474+ mp <- asks envSpeakerNotesIdMap
1475+ let mbNotesIdNum = M.lookup idNum mp
1476+ case mbElement of
1477+ Just element | Just notesIdNum <- mbNotesIdNum ->
1478+ Just <$>
1479+ elemToEntry
1480+ ("ppt/notesSlides/_rels/notesSlide" ++ show notesIdNum ++ ".xml.rels")
1481+ element
1482+ _ -> return Nothing
1483+
12551484slideToSlideRelEntry :: PandocMonad m => Slide -> P m Entry
12561485slideToSlideRelEntry slide = do
12571486 idNum <- slideNum slide
@@ -1288,6 +1517,20 @@ mediaRelElement mInfo =
12881517 , ("Target", "../media/image" ++ (show $ mInfoGlobalId mInfo) ++ ext)
12891518 ] ()
12901519
1520+speakerNotesSlideRelElement :: PandocMonad m => Slide -> P m (Maybe Element)
1521+speakerNotesSlideRelElement slide = do
1522+ idNum <- slideNum slide
1523+ mp <- asks envSpeakerNotesIdMap
1524+ return $ case M.lookup idNum mp of
1525+ Nothing -> Nothing
1526+ Just n ->
1527+ let target = "../notesSlides/notesSlide" ++ show n ++ ".xml"
1528+ in Just $
1529+ mknode "Relationship" [ ("Id", "rId2")
1530+ , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesSlide")
1531+ , ("Target", target)
1532+ ] ()
1533+
12911534slideToSlideRelElement :: PandocMonad m => Slide -> P m Element
12921535slideToSlideRelElement slide = do
12931536 idNum <- slideNum slide
@@ -1297,6 +1540,8 @@ slideToSlideRelElement slide = do
12971540 (Slide _ (ContentSlide _ _) _) -> "../slideLayouts/slideLayout2.xml"
12981541 (Slide _ (TwoColumnSlide _ _ _) _) -> "../slideLayouts/slideLayout4.xml"
12991542
1543+ speakerNotesRels <- maybeToList <$> speakerNotesSlideRelElement slide
1544+
13001545 linkIds <- gets stLinkIds
13011546 mediaIds <- gets stMediaIds
13021547
@@ -1313,7 +1558,7 @@ slideToSlideRelElement slide = do
13131558 ([mknode "Relationship" [ ("Id", "rId1")
13141559 , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slideLayout")
13151560 , ("Target", target)] ()
1316− ] ++ linkRels ++ mediaRels)
1561+ ] ++ speakerNotesRels ++ linkRels ++ mediaRels)
13171562
13181563slideToSldIdElement :: PandocMonad m => Slide -> P m Element
13191564slideToSldIdElement slide = do
@@ -1328,7 +1573,7 @@ presentationToSldIdLst (Presentation _ slides) = do
13281573 return $ mknode "p:sldIdLst" [] ids
13291574
13301575presentationToPresentationElement :: PandocMonad m => Presentation -> P m Element
1331−presentationToPresentationElement pres = do
1576+presentationToPresentationElement pres@(Presentation _ slds) = do
13321577 refArchive <- asks envRefArchive
13331578 distArchive <- asks envDistArchive
13341579 element <- parseXml refArchive distArchive "ppt/presentation.xml"
@@ -1340,18 +1585,28 @@ presentationToPresentationElement pres = do
13401585 _ -> Elem e
13411586 modifySldIdLst ct = ct
13421587
1343− removeSpeakerNotes' :: Content -> [Content]
1344− removeSpeakerNotes' (Elem e) = case elName e of
1345− (QName "notesMasterIdLst" _ _) -> []
1346− _ -> [Elem e]
1347− removeSpeakerNotes' ct = [ct]
1588+ notesMasterRId = length slds + 2
1589+
1590+ modifySpeakerNotes' :: Content -> [Content]
1591+ modifySpeakerNotes' (Elem e) = case elName e of
1592+ (QName "notesMasterIdLst" _ _) ->
1593+ if presHasSpeakerNotes pres
1594+ then [Elem $
1595+ mknode "p:notesMasterIdLst" []
1596+ [ mknode
1597+ "p:NotesMasterId"
1598+ [("r:id", "rId" ++ show notesMasterRId)]
1599+ ()
1600+ ]
1601+ ]
1602+ else []
1603+ _ -> [Elem e]
1604+ modifySpeakerNotes' ct = [ct]
13481605
1349− removeSpeakerNotes :: [Content] -> [Content]
1350− removeSpeakerNotes = if not (hasSpeakerNotes pres)
1351− then concatMap removeSpeakerNotes'
1352− else id
1606+ modifySpeakerNotes :: [Content] -> [Content]
1607+ modifySpeakerNotes = concatMap modifySpeakerNotes'
13531608
1354− newContent = removeSpeakerNotes $ map modifySldIdLst $ elContent element
1609+ newContent = modifySpeakerNotes $ map modifySldIdLst $ elContent element
13551610
13561611 return $ element{elContent = newContent}
13571612
@@ -1452,6 +1707,12 @@ mediaContentType mInfo
14521707 }
14531708 | otherwise = Nothing
14541709
1710+getSpeakerNotesFilePaths :: PandocMonad m => P m [FilePath]
1711+getSpeakerNotesFilePaths = do
1712+ mp <- asks envSpeakerNotesIdMap
1713+ let notesIdNums = M.elems mp
1714+ return $ map (\n -> "ppt/notesSlides/notesSlide" ++ show n ++ ".xml") notesIdNums
1715+
14551716presentationToContentTypes :: PandocMonad m => Presentation -> P m ContentTypes
14561717presentationToContentTypes p@(Presentation _ slides) = do
14571718 mediaInfos <- (mconcat . M.elems) <$> gets stMediaIds
@@ -1471,9 +1732,10 @@ presentationToContentTypes p@(Presentation _ slides) = do
14711732 let slideOverrides = mapMaybe
14721733 (\fp -> pathToOverride $ "ppt/slides/" ++ fp)
14731734 relativePaths
1735+ speakerNotesOverrides <- (mapMaybe pathToOverride) <$> getSpeakerNotesFilePaths
14741736 return $ ContentTypes
14751737 (defaults ++ mediaDefaults)
1476− (inheritedOverrides ++ docPropsOverride ++ presOverride ++ slideOverrides)
1738+ (inheritedOverrides ++ docPropsOverride ++ presOverride ++ slideOverrides ++ speakerNotesOverrides)
14771739
14781740presML :: String
14791741presML = "application/vnd.openxmlformats-officedocument.presentationml"