aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Slides.hs57
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs54
2 files changed, 44 insertions, 67 deletions
diff --git a/src/Text/Pandoc/Slides.hs b/src/Text/Pandoc/Slides.hs
index d45af4f1c..ba68bbd67 100644
--- a/src/Text/Pandoc/Slides.hs
+++ b/src/Text/Pandoc/Slides.hs
@@ -28,51 +28,8 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Utility functions for splitting documents into slides for slide
show formats (dzslides, s5, slidy, beamer).
-}
-module Text.Pandoc.Slides ( toSlideElements, SlideElement(..) ) where
+module Text.Pandoc.Slides ( getSlideLevel, prepSlides ) where
import Text.Pandoc.Definition
-import Text.ParserCombinators.Parsec
-import Text.Parsec.Pos (initialPos)
-import Control.Monad
-
-data SlideElement = SectionSlide Int [Inline]
- | ContentSlide [Inline] [Block] -- title - contents
- deriving (Read, Show)
-
-toSlideElements :: [Block] -> [SlideElement]
-toSlideElements bs =
- case parse (pElements $ getSlideLevel bs) "blocks" bs of
- Left err -> error $ "toSlideElements: " ++ show err -- should never happen
- Right res -> res
-
-satisfies :: (Block -> Bool) -> GenParser Block () Block
-satisfies f = token show (const $ initialPos "blocks")
- (\x -> if f x then Just x else Nothing)
-
-pElements :: Int -> GenParser Block () [SlideElement]
-pElements slideLevel = do
- res <- many (pSectionSlide slideLevel <|> pContentSlide slideLevel)
- eof
- return res
-
-pContentSlide :: Int -> GenParser Block () SlideElement
-pContentSlide slideLevel = try $ do
- hrs <- many $ satisfies (== HorizontalRule)
- Header _ tit <- option (Header 1 []) $ satisfies (isHeader (== slideLevel))
- xs <- many $ try $ notFollowedBy (satisfies (== HorizontalRule)) >>
- notFollowedBy (satisfies (isHeader (<= slideLevel))) >>
- anyToken
- guard $ not (null hrs && null tit && null xs) -- make sure we can't match empty
- return $ ContentSlide tit xs
-
-pSectionSlide :: Int -> GenParser Block () SlideElement
-pSectionSlide slideLevel = try $ do
- skipMany $ satisfies (== HorizontalRule)
- Header lvl txt <- satisfies (isHeader (< slideLevel))
- return $ SectionSlide lvl txt
-
-isHeader :: (Int -> Bool) -> Block -> Bool
-isHeader f (Header n _) = f n
-isHeader _ _ = False
-- | Find level of header that starts slides (defined as the least header
-- level that occurs before a non-header/non-hrule in the blocks).
@@ -86,3 +43,15 @@ getSlideLevel = go 6
nonHOrHR (Header _ _) = False
nonHOrHR (HorizontalRule) = False
nonHOrHR _ = True
+
+-- | Prepare a block list to be passed to hierarchicalize.
+prepSlides :: Int -> [Block] -> [Block]
+prepSlides slideLevel = ensureStartWithH . splitHrule
+ where splitHrule (HorizontalRule : Header n xs : ys)
+ | n == slideLevel = Header slideLevel xs : splitHrule ys
+ splitHrule (HorizontalRule : xs) = Header slideLevel [] : splitHrule xs
+ splitHrule (x : xs) = x : splitHrule xs
+ splitHrule [] = []
+ ensureStartWithH bs@(Header n _:_)
+ | n == slideLevel = bs
+ ensureStartWithH bs = Header slideLevel [] : bs
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index 6291300b0..e4844fde2 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -200,29 +200,37 @@ inCmd :: String -> Doc -> Doc
inCmd cmd contents = char '\\' <> text cmd <> braces contents
toSlides :: [Block] -> State WriterState [Block]
-toSlides bs = concat `fmap` (mapM slideToBeamer $ toSlideElements bs)
-
-slideToBeamer :: SlideElement -> State WriterState [Block]
-slideToBeamer (SectionSlide lvl tit) = return [Header lvl tit]
-slideToBeamer (ContentSlide tit bs) = do
- tit' <- inlineListToLaTeX tit
- -- note: [fragile] is required or verbatim breaks
- let hasCodeBlock (CodeBlock _ _) = [True]
- hasCodeBlock _ = []
- let hasCode (Code _ _) = [True]
- hasCode _ = []
- let fragile = if not $ null $ queryWith hasCodeBlock bs ++ queryWith hasCode bs
- then "[fragile]"
- else ""
- let slideStart = RawBlock "latex" ("\\begin{frame}" ++ fragile ++
- "\\frametitle{" ++ render Nothing tit' ++ "}")
- let slideEnd = RawBlock "latex" "\\end{frame}"
- -- now carve up slide into blocks if there are sections inside
- let eltToBlocks (Blk b) = [b]
- eltToBlocks (Sec _ _ _ lab xs) =
- Para (RawInline "latex" "\\begin{block}{" : lab ++ [RawInline "latex" "}"])
- : concatMap eltToBlocks xs ++ [RawBlock "latex" "\\end{block}"]
- return $ slideStart : concatMap eltToBlocks (hierarchicalize bs) ++ [slideEnd]
+toSlides bs = do
+ let slideLevel = getSlideLevel bs
+ let bs' = prepSlides slideLevel bs
+ concat `fmap` (mapM (elementToBeamer slideLevel) $ hierarchicalize bs')
+
+elementToBeamer :: Int -> Element -> State WriterState [Block]
+elementToBeamer _slideLevel (Blk b) = return [b]
+elementToBeamer slideLevel (Sec lvl _num _ident tit elts)
+ | lvl > slideLevel = do
+ bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts
+ return $ Para ( RawInline "latex" "\\begin{block}{"
+ : tit ++ [RawInline "latex" "}"] )
+ : bs ++ [RawBlock "latex" "\\end{block}"]
+ | lvl < slideLevel = do
+ bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts
+ return $ (Header lvl tit) : bs
+ | otherwise = do -- lvl == slideLevel
+ -- note: [fragile] is required or verbatim breaks
+ let hasCodeBlock (CodeBlock _ _) = [True]
+ hasCodeBlock _ = []
+ let hasCode (Code _ _) = [True]
+ hasCode _ = []
+ let fragile = if not $ null $ queryWith hasCodeBlock elts ++ queryWith hasCode elts
+ then "[fragile]"
+ else ""
+ let slideStart = Para $ RawInline "latex" ("\\begin{frame}" ++ fragile ++
+ "\\frametitle{") : tit ++ [RawInline "latex" "}"]
+ let slideEnd = RawBlock "latex" "\\end{frame}"
+ -- now carve up slide into blocks if there are sections inside
+ bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts
+ return $ slideStart : bs ++ [slideEnd]
isListBlock :: Block -> Bool
isListBlock (BulletList _) = True