diff options
Diffstat (limited to 'src/Text/Pandoc')
| -rw-r--r-- | src/Text/Pandoc/Slides.hs | 57 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/LaTeX.hs | 54 |
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 |