@@ -43,6 +43,7 @@ import Data.Time.Clock (UTCTime)
4343import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime)
4444import System.FilePath.Posix (splitDirectories, splitExtension)
4545import Text.XML.Light
46+import qualified Text.XML.Light.Cursor as XMLC
4647import Text.Pandoc.Definition
4748import qualified Text.Pandoc.UTF8 as UTF8
4849import Text.Pandoc.Class (PandocMonad)
@@ -191,10 +192,14 @@ data Slide = MetadataSlide { metadataSlideTitle :: [ParaElem]
191192 , metadataSlideAuthors :: [[ParaElem]]
192193 , metadataSlideDate :: [ParaElem]
193194 }
194− | TitleSlide { titleSlideHeader :: [ParaElem]}
195− | ContentSlide { contentSlideHeader :: [ParaElem]
195+ | TitleSlide { slideHeader :: [ParaElem]}
196+ | ContentSlide { slideHeader :: [ParaElem]
196197 , contentSlideContent :: [Shape]
197198 }
199+ | TwoColumnSlide { slideHeader :: [ParaElem]
200+ , twoColumnSlideLeft :: [Shape]
201+ , twoColumnSlideRight :: [Shape]
202+ }
198203 deriving (Show, Eq)
199204
200205data SlideElement = SlideElement Pixels Pixels Pixels Pixels Shape
@@ -553,6 +558,12 @@ splitBlocks' cur acc (tbl@(Table _ _ _ _ _) : blks) = do
553558 (Header n _ _) : [] | n == slideLevel ->
554559 splitBlocks' [] (acc ++ [cur ++ [tbl]]) blks
555560 _ -> splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [[tbl]]) blks
561+splitBlocks' cur acc (d@(Div (_, classes, _) _): blks) | "columns" `elem` classes = do
562+ slideLevel <- asks envSlideLevel
563+ case cur of
564+ (Header n _ _) : [] | n == slideLevel ->
565+ splitBlocks' [] (acc ++ [cur ++ [d]]) blks
566+ _ -> splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [[d]]) blks
556567splitBlocks' cur acc (blk : blks) = splitBlocks' (cur ++ [blk]) acc blks
557568
558569splitBlocks :: Monad m => [Block] -> P m [[Block]]
@@ -562,25 +573,37 @@ blocksToSlide' :: PandocMonad m => Int -> [Block] -> P m Slide
562573blocksToSlide' lvl ((Header n _ ils) : blks)
563574 | n < lvl = do
564575 hdr <- inlinesToParElems ils
565− return $ TitleSlide {titleSlideHeader = hdr}
576+ return $ TitleSlide {slideHeader = hdr}
566577 | n == lvl = do
567578 hdr <- inlinesToParElems ils
568− inNoteSlide <- asks envInNoteSlide
569− shapes <- if inNoteSlide
570− then forceFontSize noteSize $ blocksToShapes blks
571− else blocksToShapes blks
572− return $ ContentSlide { contentSlideHeader = hdr
573− , contentSlideContent = shapes
574− }
579+ -- Now get the slide without the header, and then add the header
580+ -- in.
581+ slide <- blocksToSlide' lvl blks
582+ return $ slide {slideHeader = hdr}
583+blocksToSlide' _ (blk : blks)
584+ | Div (_, classes, _) divBlks <- blk
585+ , "columns" `elem` classes
586+ , (Div (_, clsL, _) blksL) : (Div (_, clsR, _) blksR) : remaining <- divBlks
587+ , "column" `elem` clsL, "column" `elem` clsR = do
588+ unless (null blks)
589+ (mapM (P.report . BlockNotRendered) blks >> return ())
590+ unless (null remaining)
591+ (mapM (P.report . BlockNotRendered) remaining >> return ())
592+ shapesL <- blocksToShapes blksL
593+ shapesR <- blocksToShapes blksR
594+ return $ TwoColumnSlide { slideHeader = []
595+ , twoColumnSlideLeft = shapesL
596+ , twoColumnSlideRight = shapesR
597+ }
575598blocksToSlide' _ (blk : blks) = do
576599 inNoteSlide <- asks envInNoteSlide
577600 shapes <- if inNoteSlide
578601 then forceFontSize noteSize $ blocksToShapes (blk : blks)
579602 else blocksToShapes (blk : blks)
580− return $ ContentSlide { contentSlideHeader = []
603+ return $ ContentSlide { slideHeader = []
581604 , contentSlideContent = shapes
582605 }
583−blocksToSlide' _ [] = return $ ContentSlide { contentSlideHeader = []
606+blocksToSlide' _ [] = return $ ContentSlide { slideHeader = []
584607 , contentSlideContent = []
585608 }
586609
@@ -776,6 +799,7 @@ getLayout slide = do
776799 (MetadataSlide _ _ _ _) -> "ppt/slideLayouts/slideLayout1.xml"
777800 (TitleSlide _) -> "ppt/slideLayouts/slideLayout3.xml"
778801 (ContentSlide _ _) -> "ppt/slideLayouts/slideLayout2.xml"
802+ (TwoColumnSlide _ _ _) -> "ppt/slideLayouts/slideLayout4.xml"
779803 distArchive <- asks envDistArchive
780804 root <- case findEntryByPath layoutpath distArchive of
781805 Just e -> case parseXMLDoc $ UTF8.toStringLazy $ fromEntry e of
@@ -1377,6 +1401,53 @@ contentToElement layout hdrShape shapes
13771401 spTree
13781402contentToElement _ _ _ = return $ mknode "p:sp" [] ()
13791403
1404+setIdx'' :: NameSpaces -> String -> Content -> Content
1405+setIdx'' _ idx (Elem element) =
1406+ let tag = XMLC.getTag element
1407+ attrs = XMLC.tagAttribs tag
1408+ idxKey = (QName "idx" Nothing Nothing)
1409+ attrs' = Attr idxKey idx : (filter (\a -> attrKey a /= idxKey) attrs)
1410+ tag' = tag {XMLC.tagAttribs = attrs'}
1411+ in Elem $ XMLC.setTag tag' element
1412+setIdx'' _ _ c = c
1413+
1414+setIdx' :: NameSpaces -> String -> XMLC.Cursor -> XMLC.Cursor
1415+setIdx' ns idx cur =
1416+ let modifiedCur = XMLC.modifyContent (setIdx'' ns idx) cur
1417+ in
1418+ case XMLC.nextDF modifiedCur of
1419+ Just cur' -> setIdx' ns idx cur'
1420+ Nothing -> XMLC.root modifiedCur
1421+
1422+setIdx :: NameSpaces -> String -> Element -> Element
1423+setIdx ns idx element =
1424+ let cur = XMLC.fromContent (Elem element)
1425+ cur' = setIdx' ns idx cur
1426+ in
1427+ case XMLC.toTree cur' of
1428+ Elem element' -> element'
1429+ _ -> element
1430+
1431+twoColumnToElement :: PandocMonad m => Element -> [ParaElem] -> [Shape] -> [Shape] -> P m Element
1432+twoColumnToElement layout hdrShape shapesL shapesR
1433+ | ns <- elemToNameSpaces layout
1434+ , Just cSld <- findChild (elemName ns "p" "cSld") layout
1435+ , Just spTree <- findChild (elemName ns "p" "spTree") cSld = do
1436+ element <- nonBodyTextToElement layout "Title 1" hdrShape
1437+ let hdrShapeElements = if null hdrShape
1438+ then []
1439+ else [element]
1440+ contentElementsL <- shapesToElements layout shapesL
1441+ contentElementsR <- shapesToElements layout shapesR
1442+ let contentElementsL' = map (setIdx ns "1") contentElementsL
1443+ contentElementsR' = map (setIdx ns "2") contentElementsR
1444+ return $
1445+ replaceNamedChildren ns "p" "sp"
1446+ (hdrShapeElements ++ contentElementsL' ++ contentElementsR')
1447+ spTree
1448+twoColumnToElement _ _ _ _= return $ mknode "p:sp" [] ()
1449+
1450+
13801451titleToElement :: PandocMonad m => Element -> [ParaElem] -> P m Element
13811452titleToElement layout titleElems
13821453 | ns <- elemToNameSpaces layout
@@ -1422,6 +1493,17 @@ slideToElement s@(ContentSlide hdrElems shapes) = do
14221493 ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
14231494 ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
14241495 ] [mknode "p:cSld" [] [spTree]]
1496+slideToElement s@(TwoColumnSlide hdrElems shapesL shapesR) = do
1497+ layout <- getLayout s
1498+ spTree <- local (\env -> if null hdrElems
1499+ then env
1500+ else env{envSlideHasHeader=True}) $
1501+ twoColumnToElement layout hdrElems shapesL shapesR
1502+ return $ mknode "p:sld"
1503+ [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
1504+ ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
1505+ ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
1506+ ] [mknode "p:cSld" [] [spTree]]
14251507slideToElement s@(TitleSlide hdrElems) = do
14261508 layout <- getLayout s
14271509 spTree <- titleToElement layout hdrElems
@@ -1574,6 +1656,7 @@ slideToSlideRelElement slide idNum = do
15741656 (MetadataSlide _ _ _ _) -> "../slideLayouts/slideLayout1.xml"
15751657 (TitleSlide _) -> "../slideLayouts/slideLayout3.xml"
15761658 (ContentSlide _ _) -> "../slideLayouts/slideLayout2.xml"
1659+ (TwoColumnSlide _ _ _) -> "../slideLayouts/slideLayout4.xml"
15771660
15781661 linkIds <- gets stLinkIds
15791662 mediaIds <- gets stMediaIds