63a2507 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Powerpoint writer: Revamp slide type

63a2507Jesse Rosenthal9 years ago

src/Text/Pandoc/Writers/Powerpoint/Output.hs+15−15

compare with master

unifiedsplit

@@ -279,9 +279,9 @@ presentationToArchive opts pres = do

279

280--------------------------------------------------

281

282−getLayout :: PandocMonad m => Slide -> P m Element

282+getLayout :: PandocMonad m => Layout -> P m Element

283−getLayout slide = do

283+getLayout layout = do

284− let layoutpath = case slide of

284+ let layoutpath = case layout of

285 (MetadataSlide _ _ _ _) -> "ppt/slideLayouts/slideLayout1.xml"

286 (TitleSlide _) -> "ppt/slideLayouts/slideLayout3.xml"

287 (ContentSlide _ _) -> "ppt/slideLayouts/slideLayout2.xml"

@@ -1028,8 +1028,8 @@ metadataToElement layout titleElems subtitleElems authorsElems dateElems

1028metadataToElement _ _ _ _ _ = return $ mknode "p:sp" [] ()

1029

1030slideToElement :: PandocMonad m => Slide -> P m Element

1031−slideToElement s@(ContentSlide hdrElems shapes) = do

1031+slideToElement (Slide _ l@(ContentSlide hdrElems shapes) _ )= do

1032− layout <- getLayout s

1032+ layout <- getLayout l

1033 spTree <- local (\env -> if null hdrElems

1034 then env

1035 else env{envSlideHasHeader=True}) $

@@ -1039,8 +1039,8 @@ slideToElement s@(ContentSlide hdrElems shapes) = do

1039 ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),

1040 ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")

1041 ] [mknode "p:cSld" [] [spTree]]

1042−slideToElement s@(TwoColumnSlide hdrElems shapesL shapesR) = do

1042+slideToElement (Slide _ l@(TwoColumnSlide hdrElems shapesL shapesR) _) = do

1043− layout <- getLayout s

1043+ layout <- getLayout l

1044 spTree <- local (\env -> if null hdrElems

1045 then env

1046 else env{envSlideHasHeader=True}) $

@@ -1050,16 +1050,16 @@ slideToElement s@(TwoColumnSlide hdrElems shapesL shapesR) = do

1050 ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),

1051 ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")

1052 ] [mknode "p:cSld" [] [spTree]]

1053−slideToElement s@(TitleSlide hdrElems) = do

1053+slideToElement (Slide _ l@(TitleSlide hdrElems) _) = do

1054− layout <- getLayout s

1054+ layout <- getLayout l

1055 spTree <- titleToElement layout hdrElems

1056 return $ mknode "p:sld"

1057 [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),

1058 ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),

1059 ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")

1060 ] [mknode "p:cSld" [] [spTree]]

1061−slideToElement s@(MetadataSlide titleElems subtitleElems authorElems dateElems) = do

1061+slideToElement (Slide _ l@(MetadataSlide titleElems subtitleElems authorElems dateElems) _) = do

1062− layout <- getLayout s

1062+ layout <- getLayout l

1063 spTree <- metadataToElement layout titleElems subtitleElems authorElems dateElems

1064 return $ mknode "p:sld"

1065 [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),

@@ -1227,10 +1227,10 @@ mediaRelElement mInfo =

1227slideToSlideRelElement :: PandocMonad m => Slide -> Int -> P m Element

1228slideToSlideRelElement slide idNum = do

1229 let target = case slide of

1230− (MetadataSlide _ _ _ _) -> "../slideLayouts/slideLayout1.xml"

1230+ (Slide _ (MetadataSlide _ _ _ _) _) -> "../slideLayouts/slideLayout1.xml"

1231− (TitleSlide _) -> "../slideLayouts/slideLayout3.xml"

1231+ (Slide _ (TitleSlide _) _) -> "../slideLayouts/slideLayout3.xml"

1232− (ContentSlide _ _) -> "../slideLayouts/slideLayout2.xml"

1232+ (Slide _ (ContentSlide _ _) _) -> "../slideLayouts/slideLayout2.xml"

1233− (TwoColumnSlide _ _ _) -> "../slideLayouts/slideLayout4.xml"

1233+ (Slide _ (TwoColumnSlide _ _ _) _) -> "../slideLayouts/slideLayout4.xml"

1234

1235 linkIds <- gets stLinkIds

1236 mediaIds <- gets stMediaIds

src/Text/Pandoc/Writers/Powerpoint/Presentation.hs+82−33

@@ -35,6 +35,9 @@ Presentation.

35module Text.Pandoc.Writers.Powerpoint.Presentation ( documentToPresentation

36 , Presentation(..)

37 , Slide(..)

38+ , Layout(..)

39+ , Notes(..)

40+ , SlideId(..)

38 , Shape(..)

41 , Shape(..)

39 , Graphic(..)

42 , Graphic(..)

40 , BulletType(..)

43 , BulletType(..)

@@ -76,7 +79,7 @@ data WriterEnv = WriterEnv { envMetadata :: Meta

76 , envSlideHasHeader :: Bool

79 , envSlideHasHeader :: Bool

77 , envInList :: Bool

80 , envInList :: Bool

78 , envInNoteSlide :: Bool

81 , envInNoteSlide :: Bool

79− , envCurSlideId :: Int

82+ , envCurSlideId :: SlideId

80 }

83 }

81 deriving (Show)

84 deriving (Show)

@@ -89,13 +92,13 @@ instance Default WriterEnv where

89 , envSlideHasHeader = False

92 , envSlideHasHeader = False

90 , envInList = False

93 , envInList = False

91 , envInNoteSlide = False

94 , envInNoteSlide = False

92− , envCurSlideId = 1

95+ , envCurSlideId = SlideId "1"

93 }

96 }

96data WriterState = WriterState { stNoteIds :: M.Map Int [Block]

99data WriterState = WriterState { stNoteIds :: M.Map Int [Block]

97 -- associate anchors with slide id

100 -- associate anchors with slide id

98− , stAnchorMap :: M.Map String Int

101+ , stAnchorMap :: M.Map String SlideId

99 , stLog :: [LogMessage]

102 , stLog :: [LogMessage]

100 } deriving (Show, Eq)

103 } deriving (Show, Eq)

101

104

@@ -124,7 +127,20 @@ type Pixels = Integer

124data Presentation = Presentation [Slide]

127data Presentation = Presentation [Slide]

125 deriving (Show)

128 deriving (Show)

126

129

130+

131+data Slide = Slide SlideId Layout (Maybe Notes)

132+ deriving (Show, Eq)

133+

134+newtype SlideId = SlideId String

135+ deriving (Show, Eq)

136+

137+-- In theory you could have anything on a notes slide but it seems

138+-- designed mainly for one textbox, so we'll just put in the contents

139+-- of that textbox, to avoid other shapes that won't work as well.

140+newtype Notes = Notes [Paragraph]

141+ deriving (Show, Eq)

142+

127−data Slide = MetadataSlide { metadataSlideTitle :: [ParaElem]

143+data Layout = MetadataSlide { metadataSlideTitle :: [ParaElem]

128 , metadataSlideSubtitle :: [ParaElem]

144 , metadataSlideSubtitle :: [ParaElem]

129 , metadataSlideAuthors :: [[ParaElem]]

145 , metadataSlideAuthors :: [[ParaElem]]

130 , metadataSlideDate :: [ParaElem]

146 , metadataSlideDate :: [ParaElem]

@@ -204,7 +220,7 @@ data Capitals = NoCapitals | SmallCapitals | AllCapitals

204type URL = String

220type URL = String

205

221

206data LinkTarget = ExternalTarget (URL, String)

222data LinkTarget = ExternalTarget (URL, String)

207− | InternalTarget Int -- slideId

223+ | InternalTarget SlideId

208 deriving (Show, Eq)

224 deriving (Show, Eq)

209

225

210data RunProps = RunProps { rPropBold :: Bool

226data RunProps = RunProps { rPropBold :: Bool

@@ -513,18 +529,20 @@ blocksToSlide' :: Int -> [Block] -> Pres Slide

513blocksToSlide' lvl ((Header n (ident, _, _) ils) : blks)

529blocksToSlide' lvl ((Header n (ident, _, _) ils) : blks)

514 | n < lvl = do

530 | n < lvl = do

515 registerAnchorId ident

531 registerAnchorId ident

532+ slideId <- asks envCurSlideId

516 hdr <- inlinesToParElems ils

533 hdr <- inlinesToParElems ils

517− return $ TitleSlide {titleSlideHeader = hdr}

534+ return $ Slide slideId (TitleSlide {titleSlideHeader = hdr}) Nothing

518 | n == lvl = do

535 | n == lvl = do

519 registerAnchorId ident

536 registerAnchorId ident

520 hdr <- inlinesToParElems ils

537 hdr <- inlinesToParElems ils

521 -- Now get the slide without the header, and then add the header

538 -- Now get the slide without the header, and then add the header

522 -- in.

539 -- in.

523− slide <- blocksToSlide' lvl blks

540+ (Slide slideId layout mbNotes) <- blocksToSlide' lvl blks

524− return $ case slide of

541+ let layout' = case layout of

525− ContentSlide _ cont -> ContentSlide hdr cont

542+ ContentSlide _ cont -> ContentSlide hdr cont

526− TwoColumnSlide _ contL contR -> TwoColumnSlide hdr contL contR

543+ TwoColumnSlide _ contL contR -> TwoColumnSlide hdr contL contR

527− slide' -> slide'

544+ layout'' -> layout''

545+ return $ Slide slideId layout' mbNotes

528blocksToSlide' _ (blk : blks)

546blocksToSlide' _ (blk : blks)

529 | Div (_, classes, _) divBlks <- blk

547 | Div (_, classes, _) divBlks <- blk

530 , "columns" `elem` classes

548 , "columns" `elem` classes

@@ -544,21 +562,36 @@ blocksToSlide' _ (blk : blks)

544 [] -> []

562 [] -> []

545 shapesL <- blocksToShapes blksL'

563 shapesL <- blocksToShapes blksL'

546 shapesR <- blocksToShapes blksR'

564 shapesR <- blocksToShapes blksR'

565+ slideId <- asks envCurSlideId

566+ return $ Slide

567+ slideId

547− return $ TwoColumnSlide { twoColumnSlideHeader = []

568+ TwoColumnSlide { twoColumnSlideHeader = []

548− , twoColumnSlideLeft = shapesL

569+ , twoColumnSlideLeft = shapesL

549− , twoColumnSlideRight = shapesR

570+ , twoColumnSlideRight = shapesR

550− }

571+ }

572+ Nothing

551blocksToSlide' _ (blk : blks) = do

573blocksToSlide' _ (blk : blks) = do

552 inNoteSlide <- asks envInNoteSlide

574 inNoteSlide <- asks envInNoteSlide

553 shapes <- if inNoteSlide

575 shapes <- if inNoteSlide

554 then forceFontSize noteSize $ blocksToShapes (blk : blks)

576 then forceFontSize noteSize $ blocksToShapes (blk : blks)

555 else blocksToShapes (blk : blks)

577 else blocksToShapes (blk : blks)

578+ slideId <- asks envCurSlideId

579+ return $

580+ Slide

581+ slideId

556− return $ ContentSlide { contentSlideHeader = []

582+ ContentSlide { contentSlideHeader = []

557− , contentSlideContent = shapes

583+ , contentSlideContent = shapes

558− }

584+ }

585+ Nothing

586+blocksToSlide' _ [] = do

587+ slideId <- asks envCurSlideId

588+ return $

589+ Slide

590+ slideId

559−blocksToSlide' _ [] = return $ ContentSlide { contentSlideHeader = []

591+ ContentSlide { contentSlideHeader = []

560− , contentSlideContent = []

592+ , contentSlideContent = []

561− }

593+ }

594+ Nothing

562

595

563blocksToSlide :: [Block] -> Pres Slide

596blocksToSlide :: [Block] -> Pres Slide

564blocksToSlide blks = do

597blocksToSlide blks = do

@@ -612,13 +645,20 @@ getMetaSlide = do

612 _ -> []

645 _ -> []

613 authors <- mapM inlinesToParElems $ docAuthors meta

646 authors <- mapM inlinesToParElems $ docAuthors meta

614 date <- inlinesToParElems $ docDate meta

647 date <- inlinesToParElems $ docDate meta

648+ slideId <- asks envCurSlideId

615 if null title && null subtitle && null authors && null date

649 if null title && null subtitle && null authors && null date

616 then return Nothing

650 then return Nothing

651+ else return $

652+ Just $

653+ Slide

654+ slideId

617− else return $ Just $ MetadataSlide { metadataSlideTitle = title

655+ MetadataSlide { metadataSlideTitle = title

618− , metadataSlideSubtitle = subtitle

656+ , metadataSlideSubtitle = subtitle

619− , metadataSlideAuthors = authors

657+ , metadataSlideAuthors = authors

620− , metadataSlideDate = date

658+ , metadataSlideDate = date

621− }

659+ }

660+ Nothing

661+

622-- adapted from the markdown writer

662-- adapted from the markdown writer

623elementToListItem :: Shared.Element -> Pres [Block]

663elementToListItem :: Shared.Element -> Pres [Block]

624elementToListItem (Shared.Sec lev _nums (ident,_,_) headerText subsecs) = do

664elementToListItem (Shared.Sec lev _nums (ident,_,_) headerText subsecs) = do

@@ -676,26 +716,35 @@ applyToShape f (TextBox paras) = do

676 paras' <- mapM (applyToParagraph f) paras

716 paras' <- mapM (applyToParagraph f) paras

677 return $ TextBox paras'

717 return $ TextBox paras'

678

718

679−applyToSlide :: Monad m => (ParaElem -> m ParaElem) -> Slide -> m Slide

719+applyToLayout :: Monad m => (ParaElem -> m ParaElem) -> Layout -> m Layout

680−applyToSlide f (MetadataSlide title subtitle authors date) = do

720+applyToLayout f (MetadataSlide title subtitle authors date) = do

681 title' <- mapM f title

721 title' <- mapM f title

682 subtitle' <- mapM f subtitle

722 subtitle' <- mapM f subtitle

683 authors' <- mapM (mapM f) authors

723 authors' <- mapM (mapM f) authors

684 date' <- mapM f date

724 date' <- mapM f date

685 return $ MetadataSlide title' subtitle' authors' date'

725 return $ MetadataSlide title' subtitle' authors' date'

686−applyToSlide f (TitleSlide title) = do

726+applyToLayout f (TitleSlide title) = do

687 title' <- mapM f title

727 title' <- mapM f title

688 return $ TitleSlide title'

728 return $ TitleSlide title'

689−applyToSlide f (ContentSlide hdr content) = do

729+applyToLayout f (ContentSlide hdr content) = do

690 hdr' <- mapM f hdr

730 hdr' <- mapM f hdr

691 content' <- mapM (applyToShape f) content

731 content' <- mapM (applyToShape f) content

692 return $ ContentSlide hdr' content'

732 return $ ContentSlide hdr' content'

693−applyToSlide f (TwoColumnSlide hdr contentL contentR) = do

733+applyToLayout f (TwoColumnSlide hdr contentL contentR) = do

694 hdr' <- mapM f hdr

734 hdr' <- mapM f hdr

695 contentL' <- mapM (applyToShape f) contentL

735 contentL' <- mapM (applyToShape f) contentL

696 contentR' <- mapM (applyToShape f) contentR

736 contentR' <- mapM (applyToShape f) contentR

697 return $ TwoColumnSlide hdr' contentL' contentR'

737 return $ TwoColumnSlide hdr' contentL' contentR'

698

738

739+applyToSlide :: Monad m => (ParaElem -> m ParaElem) -> Slide -> m Slide

740+applyToSlide f (Slide slideId layout mbNotes) = do

741+ layout' <- applyToLayout f layout

742+ mbNotes' <- case mbNotes of

743+ Just (Notes notes) -> (Just . Notes) <$>

744+ mapM (applyToParagraph f) notes

745+ Nothing -> return Nothing

746+ return $ Slide slideId layout' mbNotes'

747+

699replaceAnchor :: ParaElem -> Pres ParaElem

748replaceAnchor :: ParaElem -> Pres ParaElem

700replaceAnchor (Run rProps s)

749replaceAnchor (Run rProps s)

701 | Just (ExternalTarget ('#':anchor, _)) <- rLink rProps = do

750 | Just (ExternalTarget ('#':anchor, _)) <- rLink rProps = do

@@ -728,7 +777,7 @@ blocksToPresentation blks = do

728 let bodyStartNum = tocStartNum + tocSlidesLength

777 let bodyStartNum = tocStartNum + tocSlidesLength

729 blksLst <- splitBlocks blks

778 blksLst <- splitBlocks blks

730 bodyslides <- mapM

779 bodyslides <- mapM

731− (\(bs, n) -> local (\st -> st{envCurSlideId = n}) (blocksToSlide bs))

780+ (\(bs, n) -> local (\st -> st{envCurSlideId = SlideId $ show n}) (blocksToSlide bs))

732 (zip blksLst [bodyStartNum..])

781 (zip blksLst [bodyStartNum..])

733 let endNoteStartNum = bodyStartNum + length bodyslides

782 let endNoteStartNum = bodyStartNum + length bodyslides

734 endNotesSlideBlocks <- makeEndNotesSlideBlocks

783 endNotesSlideBlocks <- makeEndNotesSlideBlocks

@@ -742,7 +791,7 @@ blocksToPresentation blks = do

742 endNotesSlides <- if null endNotesSlideBlocks

791 endNotesSlides <- if null endNotesSlideBlocks

743 then return []

792 then return []

744 else do endNotesSlide <- local

793 else do endNotesSlide <- local

745− (\env -> env { envCurSlideId = endNoteStartNum

794+ (\env -> env { envCurSlideId = SlideId $ show endNoteStartNum

746 , envInNoteSlide = True

795 , envInNoteSlide = True

747 })

796 })

748 (blocksToSlide $ endNotesSlideBlocks)

797 (blocksToSlide $ endNotesSlideBlocks)