aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Output.hs65
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Presentation.hs76
2 files changed, 81 insertions, 60 deletions
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 =
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
index 68b2aeeb2..e68f5eb57 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
@@ -35,7 +35,6 @@ Presentation.
module Text.Pandoc.Writers.Powerpoint.Presentation ( documentToPresentation
, Presentation(..)
, Slide(..)
- , SlideElement(..)
, Shape(..)
, Graphic(..)
, BulletType(..)
@@ -50,6 +49,7 @@ module Text.Pandoc.Writers.Powerpoint.Presentation ( documentToPresentation
, PicProps(..)
, URL
, TeXString(..)
+ , LinkTarget(..)
) where
@@ -78,10 +78,6 @@ data WriterEnv = WriterEnv { envMetadata :: Meta
, envInList :: Bool
, envInNoteSlide :: Bool
, envCurSlideId :: Int
- -- the difference between the number at
- -- the end of the slide file name and
- -- the rId number
- , envSlideIdOffset :: Int
}
deriving (Show)
@@ -95,7 +91,6 @@ instance Default WriterEnv where
, envInList = False
, envInNoteSlide = False
, envCurSlideId = 1
- , envSlideIdOffset = 1
}
@@ -139,9 +134,6 @@ data Slide = MetadataSlide { metadataSlideTitle :: [ParaElem]
}
deriving (Show, Eq)
-data SlideElement = SlideElement Pixels Pixels Pixels Pixels Shape
- deriving (Show, Eq)
-
data Shape = Pic PicProps FilePath Text.Pandoc.Definition.Attr [ParaElem]
| GraphicFrame [Graphic] [ParaElem]
| TextBox [Paragraph]
@@ -206,12 +198,16 @@ data Capitals = NoCapitals | SmallCapitals | AllCapitals
type URL = String
+data LinkTarget = ExternalTarget (URL, String)
+ | InternalTarget Int -- slideId
+ deriving (Show, Eq)
+
data RunProps = RunProps { rPropBold :: Bool
, rPropItalics :: Bool
, rStrikethrough :: Maybe Strikethrough
, rBaseline :: Maybe Int
, rCap :: Maybe Capitals
- , rLink :: Maybe (URL, String)
+ , rLink :: Maybe LinkTarget
, rPropCode :: Bool
, rPropBlockQuote :: Bool
, rPropForceSize :: Maybe Pixels
@@ -229,7 +225,7 @@ instance Default RunProps where
, rPropForceSize = Nothing
}
-data PicProps = PicProps { picPropLink :: Maybe (URL, String)
+data PicProps = PicProps { picPropLink :: Maybe LinkTarget
} deriving (Show, Eq)
instance Default PicProps where
@@ -267,7 +263,7 @@ inlineToParElems Space = inlineToParElems (Str " ")
inlineToParElems SoftBreak = inlineToParElems (Str " ")
inlineToParElems LineBreak = return [Break]
inlineToParElems (Link _ ils (url, title)) = do
- local (\r ->r{envRunProps = (envRunProps r){rLink = Just (url, title)}}) $
+ local (\r ->r{envRunProps = (envRunProps r){rLink = Just $ ExternalTarget (url, title)}}) $
inlinesToParElems ils
inlineToParElems (Code _ str) = do
local (\r ->r{envRunProps = (envRunProps r){rPropCode = True}}) $
@@ -414,10 +410,10 @@ blockToShape (Para (il:_)) | Image attr ils (url, _) <- il =
Pic def url attr <$> (inlinesToParElems ils)
blockToShape (Plain (il:_)) | Link _ (il':_) target <- il
, Image attr ils (url, _) <- il' =
- Pic def{picPropLink = Just target} url attr <$> (inlinesToParElems ils)
+ Pic def{picPropLink = Just $ ExternalTarget target} url attr <$> (inlinesToParElems ils)
blockToShape (Para (il:_)) | Link _ (il':_) target <- il
, Image attr ils (url, _) <- il' =
- Pic def{picPropLink = Just target} url attr <$> (inlinesToParElems ils)
+ Pic def{picPropLink = Just $ ExternalTarget target} url attr <$> (inlinesToParElems ils)
blockToShape (Table caption algn _ hdrCells rows) = do
caption' <- inlinesToParElems caption
hdrCells' <- rowToParagraphs algn hdrCells
@@ -644,6 +640,51 @@ combineParaElems' (Just pElem') (pElem : pElems)
combineParaElems :: [ParaElem] -> [ParaElem]
combineParaElems = combineParaElems' Nothing
+applyToParagraph :: Monad m => (ParaElem -> m ParaElem) -> Paragraph -> m Paragraph
+applyToParagraph f para = do
+ paraElems' <- mapM f $ paraElems para
+ return $ para {paraElems = paraElems'}
+
+applyToShape :: Monad m => (ParaElem -> m ParaElem) -> Shape -> m Shape
+applyToShape f (Pic pPr fp attr pes) = do
+ pes' <- mapM f pes
+ return $ Pic pPr fp attr pes'
+applyToShape f (GraphicFrame gfx pes) = do
+ pes' <- mapM f pes
+ return $ GraphicFrame gfx pes'
+applyToShape f (TextBox paras) = do
+ paras' <- mapM (applyToParagraph f) paras
+ return $ TextBox paras'
+
+applyToSlide :: Monad m => (ParaElem -> m ParaElem) -> Slide -> m Slide
+applyToSlide f (MetadataSlide title subtitle authors date) = do
+ title' <- mapM f title
+ subtitle' <- mapM f subtitle
+ authors' <- mapM (mapM f) authors
+ date' <- mapM f date
+ return $ MetadataSlide title' subtitle' authors' date'
+applyToSlide f (TitleSlide title) = do
+ title' <- mapM f title
+ return $ TitleSlide title'
+applyToSlide f (ContentSlide hdr content) = do
+ hdr' <- mapM f hdr
+ content' <- mapM (applyToShape f) content
+ return $ ContentSlide hdr' content'
+applyToSlide f (TwoColumnSlide hdr contentL contentR) = do
+ hdr' <- mapM f hdr
+ contentL' <- mapM (applyToShape f) contentL
+ contentR' <- mapM (applyToShape f) contentR
+ return $ TwoColumnSlide hdr' contentL' contentR'
+
+replaceAnchor :: PandocMonad m => ParaElem -> Pres m ParaElem
+replaceAnchor (Run rProps s)
+ | Just (ExternalTarget ('#':anchor, _)) <- rLink rProps = do
+ anchorMap <- gets stAnchorMap
+ return $ case M.lookup anchor anchorMap of
+ Just n -> Run (rProps{rLink = Just $ InternalTarget n}) s
+ Nothing -> Run rProps s
+replaceAnchor pe = return pe
+
blocksToPresentation :: PandocMonad m => [Block] -> Pres m Presentation
blocksToPresentation blks = do
opts <- asks envOpts
@@ -683,9 +724,10 @@ blocksToPresentation blks = do
})
(blocksToSlide $ notesSlideBlocks)
return [notesSlide]
- return $
- Presentation $
- metadataslides ++ tocSlides ++ bodyslides ++ notesSlides
+
+ let slides = metadataslides ++ tocSlides ++ bodyslides ++ notesSlides
+ slides' <- mapM (applyToSlide replaceAnchor) slides
+ return $ Presentation slides'
documentToPresentation :: PandocMonad m
=> WriterOptions
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-11 08:38:36 +0000