@@ -146,8 +146,8 @@ data WriterState = WriterState { stLinkIds :: M.Map Int (M.Map Int (URL, String)
146146 , stMediaIds :: M.Map Int [MediaInfo]
147147 , stMediaGlobalIds :: M.Map FilePath Int
148148 , stNoteIds :: M.Map Int [Block]
149− -- anchors in the current slide
150− , stCurSlideAnchors :: M.Map String Int
149+ -- associate anchors with slide id
150+ , stAnchorMap :: M.Map String Int
151151 } deriving (Show, Eq)
152152
153153instance Default WriterState where
@@ -155,7 +155,7 @@ instance Default WriterState where
155155 , stMediaIds = mempty
156156 , stMediaGlobalIds = mempty
157157 , stNoteIds = mempty
158− , stCurSlideAnchors = mempty
158+ , stAnchorMap= mempty
159159 }
160160
161161type P m = ReaderT WriterEnv (StateT WriterState m)
@@ -377,6 +377,13 @@ isListType (BulletList _) = True
377377isListType (DefinitionList _) = True
378378isListType _ = False
379379
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+
380387blockToParagraphs :: PandocMonad m => Block -> P m [Paragraph]
381388blockToParagraphs (Plain ils) = do
382389 parElems <- inlinesToParElems ils
@@ -407,7 +414,11 @@ blockToParagraphs (BlockQuote blks) =
407414 concatMapM blockToParagraphs blks
408415-- TODO: work out the format
409416blockToParagraphs (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
411422 slideLevel <- asks envSlideLevel
412423 parElems <- inlinesToParElems ils
413424 -- For the time being we're not doing headers inside of bullets, but
@@ -564,11 +575,13 @@ splitBlocks :: Monad m => [Block] -> P m [[Block]]
564575splitBlocks = splitBlocks' [] []
565576
566577blocksToSlide' :: PandocMonad m => Int -> [Block] -> P m Slide
567−blocksToSlide' lvl ((Header n _ ils) : blks)
578+blocksToSlide' lvl ((Header n (ident, _, _) ils) : blks)
568579 | n < lvl = do
580+ registerAnchorId ident
569581 hdr <- inlinesToParElems ils
570582 return $ TitleSlide {titleSlideHeader = hdr}
571583 | n == lvl = do
584+ registerAnchorId ident
572585 hdr <- inlinesToParElems ils
573586 -- Now get the slide without the header, and then add the header
574587 -- in.
@@ -1141,11 +1154,15 @@ paraElemToElement (Run rpr s) = do
11411154 Nothing -> []) ++
11421155 []
11431156 linkProps <- case rLink rpr of
1144− Just link -> do idNum <- registerLink link
1145− return [mknode "a:hlinkClick"
1146− [("r:id", "rId" ++ show idNum)]
1147− ()
1148− ]
1157+ Just link -> do
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+ _ -> []
1165+ return [mknode "a:hlinkClick" linkAttrs' ()]
11491166 Nothing -> return []
11501167 let propContents = if rPropCode rpr
11511168 then [mknode "a:latin" [("typeface", "Courier")] ()]
@@ -1576,16 +1593,26 @@ slideToSlideRelEntry slide idNum = do
15761593 element <- slideToSlideRelElement slide idNum
15771594 elemToEntry ("ppt/slides/_rels/" ++ slideToFilePath slide idNum ++ ".rels") element
15781595
1579−linkRelElement :: Int -> (URL, String) -> Element
1580−linkRelElement idNum (url, _) =
1581− mknode "Relationship" [ ("Id", "rId" ++ show idNum)
1582− , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink")
1596+linkRelElement :: PandocMonad m => Int -> (URL, String) -> P m Element
1597+linkRelElement idNum (url, _) = do
1598+ anchorMap <- gets stAnchorMap
1599+ case url of
1600+ '#' : anchor | Just num <- M.lookup anchor anchorMap ->
1601+ return $
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)
1609+ , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink")
15831610 , ("Target", url)
15841611 , ("TargetMode", "External")
15851612 ] ()
15861613
1587−linkRelElements :: M.Map Int (URL, String) -> [Element]
1588−linkRelElements mp = map (\(n, lnk) -> linkRelElement n lnk) (M.toList mp)
1614+linkRelElements :: PandocMonad m => M.Map Int (URL, String) -> P m [Element]
1615+linkRelElements mp = mapM (\(n, lnk) -> linkRelElement n lnk) (M.toList mp)
15891616
15901617mediaRelElement :: MediaInfo -> Element
15911618mediaRelElement mInfo =
@@ -1609,10 +1636,10 @@ slideToSlideRelElement slide idNum = do
16091636 linkIds <- gets stLinkIds
16101637 mediaIds <- gets stMediaIds
16111638
1612− let linkRels = case M.lookup idNum linkIds of
1613− Just mp -> linkRelElements mp
1614− Nothing -> []
1615− mediaRels = case M.lookup idNum mediaIds of
1639+ linkRels <- case M.lookup idNum linkIds of
1640+ Just mp -> linkRelElements mp
1641+ Nothing -> return []
1642+ let mediaRels = case M.lookup idNum mediaIds of
16161643 Just mInfos -> map mediaRelElement mInfos
16171644 Nothing -> []
16181645