2afca42 · typeable/pandoc

146 , stMediaIds :: M.Map Int [MediaInfo]

147 , stMediaGlobalIds :: M.Map FilePath Int

148 , stNoteIds :: M.Map Int [Block]

149− -- anchors in the current slide

149+ -- associate anchors with slide id

150− , stCurSlideAnchors :: M.Map String Int

150+ , stAnchorMap :: M.Map String Int

151 } deriving (Show, Eq)

152

153instance Default WriterState where

155 , stMediaIds = mempty

156 , stMediaGlobalIds = mempty

157 , stNoteIds = mempty

158− , stCurSlideAnchors = mempty

158+ , stAnchorMap= mempty

159 }

160

161type P m = ReaderT WriterEnv (StateT WriterState m)

377isListType (DefinitionList _) = True

378isListType _ = False

379

380+registerAnchorId :: PandocMonad m => String -> P m ()

381+registerAnchorId anchor = do

382+ anchorMap <- gets stAnchorMap

383+ slideId <- asks envCurSlideId

384+ unless (null anchor) $

385+ modify $ \st -> st {stAnchorMap = M.insert anchor slideId anchorMap}

386+

380blockToParagraphs :: PandocMonad m => Block -> P m [Paragraph]

387blockToParagraphs :: PandocMonad m => Block -> P m [Paragraph]

381blockToParagraphs (Plain ils) = do

388blockToParagraphs (Plain ils) = do

382 parElems <- inlinesToParElems ils

389 parElems <- inlinesToParElems ils

407 concatMapM blockToParagraphs blks

414 concatMapM blockToParagraphs blks

408-- TODO: work out the format

415-- TODO: work out the format

409blockToParagraphs (RawBlock _ _) = return []

416blockToParagraphs (RawBlock _ _) = return []

410−blockToParagraphs (Header n _ ils) = do

417+blockToParagraphs (Header n (ident, _, _) ils) = do

418+ -- Note that this function will only touch headers that are not at

419+ -- the beginning of slides -- all the rest will be taken care of by

420+ -- `blocksToSlide'`. We have the register anchors in both of them.

421+ registerAnchorId ident

411 slideLevel <- asks envSlideLevel

422 slideLevel <- asks envSlideLevel

412 parElems <- inlinesToParElems ils

423 parElems <- inlinesToParElems ils

413 -- For the time being we're not doing headers inside of bullets, but

424 -- For the time being we're not doing headers inside of bullets, but

564splitBlocks = splitBlocks' [] []

575splitBlocks = splitBlocks' [] []

565

576

566blocksToSlide' :: PandocMonad m => Int -> [Block] -> P m Slide

577blocksToSlide' :: PandocMonad m => Int -> [Block] -> P m Slide

567−blocksToSlide' lvl ((Header n _ ils) : blks)

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

568 | n < lvl = do

579 | n < lvl = do

580+ registerAnchorId ident

569 hdr <- inlinesToParElems ils

581 hdr <- inlinesToParElems ils

570 return $ TitleSlide {titleSlideHeader = hdr}

582 return $ TitleSlide {titleSlideHeader = hdr}

571 | n == lvl = do

583 | n == lvl = do

584+ registerAnchorId ident

572 hdr <- inlinesToParElems ils

585 hdr <- inlinesToParElems ils

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

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

574 -- in.

587 -- in.

1141 Nothing -> []) ++

1154 Nothing -> []) ++

1142 []

1155 []

1143 linkProps <- case rLink rpr of

1156 linkProps <- case rLink rpr of

1157+ Just link -> do

1144− Just link -> do idNum <- registerLink link

1158+ idNum <- registerLink link

1159+ let (url, _) = link

1160+ linkAttrs = [("r:id", "rId" ++ show idNum)]

1161+ -- we have to add an extra action if it's an anchor.

1162+ linkAttrs' = linkAttrs ++ case url of

1163+ '#' : _ -> [("action", "ppaction://hlinksldjump")]

1164+ _ -> []

1145− return [mknode "a:hlinkClick"

1165+ return [mknode "a:hlinkClick" linkAttrs' ()]

1146− [("r:id", "rId" ++ show idNum)]

1147− ()

1148− ]

1149 Nothing -> return []

1166 Nothing -> return []

1150 let propContents = if rPropCode rpr

1167 let propContents = if rPropCode rpr

1151 then [mknode "a:latin" [("typeface", "Courier")] ()]

1168 then [mknode "a:latin" [("typeface", "Courier")] ()]

1576 element <- slideToSlideRelElement slide idNum

1593 element <- slideToSlideRelElement slide idNum

1577 elemToEntry ("ppt/slides/_rels/" ++ slideToFilePath slide idNum ++ ".rels") element

1594 elemToEntry ("ppt/slides/_rels/" ++ slideToFilePath slide idNum ++ ".rels") element

1578

1595

1579−linkRelElement :: Int -> (URL, String) -> Element

1596+linkRelElement :: PandocMonad m => Int -> (URL, String) -> P m Element

1580−linkRelElement idNum (url, _) =

1597+linkRelElement idNum (url, _) = do

1598+ anchorMap <- gets stAnchorMap

1599+ case url of

1600+ '#' : anchor | Just num <- M.lookup anchor anchorMap ->

1601+ return $

1581− mknode "Relationship" [ ("Id", "rId" ++ show idNum)

1602+ mknode "Relationship" [ ("Id", "rId" ++ show idNum)

1603+ , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide")

1604+ , ("Target", "slide" ++ show num ++ ".xml")

1605+ ] ()

1606+ _ ->

1607+ return $

1608+ mknode "Relationship" [ ("Id", "rId" ++ show idNum)

1582− , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink")

1609+ , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink")

1583 , ("Target", url)

1610 , ("Target", url)

1584 , ("TargetMode", "External")

1611 , ("TargetMode", "External")

1585 ] ()

1612 ] ()

1586

1613

1587−linkRelElements :: M.Map Int (URL, String) -> [Element]

1614+linkRelElements :: PandocMonad m => M.Map Int (URL, String) -> P m [Element]

1588−linkRelElements mp = map (\(n, lnk) -> linkRelElement n lnk) (M.toList mp)

1615+linkRelElements mp = mapM (\(n, lnk) -> linkRelElement n lnk) (M.toList mp)

1589

1616

1590mediaRelElement :: MediaInfo -> Element

1617mediaRelElement :: MediaInfo -> Element

1591mediaRelElement mInfo =

1618mediaRelElement mInfo =

1609 linkIds <- gets stLinkIds

1636 linkIds <- gets stLinkIds

1610 mediaIds <- gets stMediaIds

1637 mediaIds <- gets stMediaIds

1611

1638

1612− let linkRels = case M.lookup idNum linkIds of

1639+ linkRels <- case M.lookup idNum linkIds of

1613− Just mp -> linkRelElements mp

1640+ Just mp -> linkRelElements mp

1614− Nothing -> []

1641+ Nothing -> return []

1615− mediaRels = case M.lookup idNum mediaIds of

1642+ let mediaRels = case M.lookup idNum mediaIds of

1616 Just mInfos -> map mediaRelElement mInfos

1643 Just mInfos -> map mediaRelElement mInfos

1617 Nothing -> []

1644 Nothing -> []

1618

1645