From 3156722ac413ddbc200dfcfdabcf08e7c2e1875d Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Sun, 14 Jan 2018 21:56:00 -0500 Subject: Powerpoint writer: Fix anchor links. They were broken when I refactored (the Output module wanted to use state left over from the construction of the Presentation type). This change introduces a new type `LinkTarget = InternalTarget | ExternalTarget`. Internal target points to a slide number, and these will all be resolved before the Presentation is passed along to the Output module. --- src/Text/Pandoc/Writers/Powerpoint/Output.hs | 65 ++++++++++------------------ 1 file changed, 22 insertions(+), 43 deletions(-) (limited to 'src/Text/Pandoc/Writers/Powerpoint/Output.hs') diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs index f3df62690..c45479579 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs @@ -54,7 +54,7 @@ import Text.Pandoc.MIME import qualified Data.ByteString.Lazy as BL import Text.Pandoc.Writers.OOXML import qualified Data.Map as M -import Data.Maybe (mapMaybe, listToMaybe, catMaybes) +import Data.Maybe (mapMaybe, listToMaybe) import Text.Pandoc.ImageSize import Control.Applicative ((<|>)) import System.FilePath.Glob @@ -135,24 +135,16 @@ data MediaInfo = MediaInfo { mInfoFilePath :: FilePath , mInfoCaption :: Bool } deriving (Show, Eq) -data WriterState = WriterState { stLinkIds :: M.Map Int (M.Map Int (URL, String)) +data WriterState = WriterState { stLinkIds :: M.Map Int (M.Map Int LinkTarget) -- (FP, Local ID, Global ID, Maybe Mime) , stMediaIds :: M.Map Int [MediaInfo] , stMediaGlobalIds :: M.Map FilePath Int - , stNoteIds :: M.Map Int [Block] - -- associate anchors with slide id - , stAnchorMap :: M.Map String Int - -- media inherited from the template. - , stTemplateMedia :: [FilePath] } deriving (Show, Eq) instance Default WriterState where def = WriterState { stLinkIds = mempty , stMediaIds = mempty , stMediaGlobalIds = mempty - , stNoteIds = mempty - , stAnchorMap= mempty - , stTemplateMedia = [] } type P m = ReaderT WriterEnv (StateT WriterState m) @@ -420,7 +412,7 @@ replaceNamedChildren ns prefix name newKids element = ---------------------------------------------------------------- -registerLink :: PandocMonad m => (URL, String) -> P m Int +registerLink :: PandocMonad m => LinkTarget -> P m Int registerLink link = do curSlideId <- asks envCurSlideId linkReg <- gets stLinkIds @@ -729,20 +721,15 @@ paraElemToElement (Run rpr s) = do -- first we have to make sure that if it's an -- anchor, it's in the anchor map. If not, there's -- no link. - anchorMap <- gets stAnchorMap return $ case link of - -- anchor with nothing in the map - ('#':target, _) | Nothing <- M.lookup target anchorMap -> - [] - -- anchor that is in the map - ('#':_, _) -> + InternalTarget _ -> let linkAttrs = [ ("r:id", "rId" ++ show idNum) , ("action", "ppaction://hlinksldjump") ] in [mknode "a:hlinkClick" linkAttrs ()] -- external - _ -> + ExternalTarget _ -> let linkAttrs = [ ("r:id", "rId" ++ show idNum) ] @@ -1191,31 +1178,23 @@ slideToSlideRelEntry slide idNum = do element <- slideToSlideRelElement slide idNum elemToEntry ("ppt/slides/_rels/" ++ slideToFilePath slide idNum ++ ".rels") element -linkRelElement :: PandocMonad m => Int -> (URL, String) -> P m (Maybe Element) -linkRelElement idNum (url, _) = do - anchorMap <- gets stAnchorMap - case url of - -- if it's an anchor in the map, we use the slide number for an - -- internal link. - '#' : anchor | Just num <- M.lookup anchor anchorMap -> - return $ Just $ - mknode "Relationship" [ ("Id", "rId" ++ show idNum) - , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide") - , ("Target", "slide" ++ show num ++ ".xml") - ] () - -- if it's an anchor not in the map, we return nothing. - '#' : _ -> return Nothing - -- Anything else we treat as an external link - _ -> - return $ Just $ - mknode "Relationship" [ ("Id", "rId" ++ show idNum) - , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink") - , ("Target", url) - , ("TargetMode", "External") - ] () - -linkRelElements :: PandocMonad m => M.Map Int (URL, String) -> P m [Element] -linkRelElements mp = catMaybes <$> mapM (\(n, lnk) -> linkRelElement n lnk) (M.toList mp) +linkRelElement :: PandocMonad m => Int -> LinkTarget -> P m Element +linkRelElement idNum (InternalTarget num) = do + return $ + mknode "Relationship" [ ("Id", "rId" ++ show idNum) + , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide") + , ("Target", "slide" ++ show num ++ ".xml") + ] () +linkRelElement idNum (ExternalTarget (url, _)) = do + return $ + mknode "Relationship" [ ("Id", "rId" ++ show idNum) + , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink") + , ("Target", url) + , ("TargetMode", "External") + ] () + +linkRelElements :: PandocMonad m => M.Map Int LinkTarget -> P m [Element] +linkRelElements mp = mapM (\(n, lnk) -> linkRelElement n lnk) (M.toList mp) mediaRelElement :: MediaInfo -> Element mediaRelElement mInfo = -- cgit v1.2.3