Use Slides in LaTeX writer for beamer.

2 files changed, 23 insertions, 39 deletions

diff --git a/src/Text/Pandoc/Slides.hs b/src/Text/Pandoc/Slides.hs
index 0fd037d0b..d89cf1dcd 100644
--- a/src/Text/Pandoc/Slides.hs
+++ b/src/Text/Pandoc/Slides.hs
@@ -28,14 +28,14 @@ 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 ( ) where
+module Text.Pandoc.Slides ( toSlideElements, SlideElement(..) ) where
 import Text.Pandoc.Definition
 import Text.ParserCombinators.Parsec
 import Text.Parsec.Pos (initialPos)
 import Control.Monad
 
 data SlideElement = SectionSlide Int [Inline]
-                  | ContentSlide [Inline] [Inline] [Block]  -- title - subtitle - contents
+                  | ContentSlide [Inline] [Block]  -- title - contents
                   deriving (Read, Show)
 
 toSlideElements :: [Block] -> [SlideElement]
@@ -44,9 +44,6 @@ toSlideElements bs =
        Left err   -> error $ show err
        Right res  -> res
 
-anyTok :: GenParser Block () Block
-anyTok = token show (const $ initialPos "blocks") Just
-
 satisfies :: (Block -> Bool) -> GenParser Block () Block
 satisfies f = token show (const $ initialPos "blocks")
                    (\x -> if f x then Just x else Nothing)
@@ -61,12 +58,11 @@ pContentSlide :: Int -> GenParser Block () SlideElement
 pContentSlide slideLevel = try $ do
   hrs <- many $ satisfies (== HorizontalRule)
   Header _ tit <- option (Header 1 []) $ satisfies (isHeader (== slideLevel))
-  Header _ subtit <- option (Header 1 []) $ satisfies (isHeader (== slideLevel + 1))
-  guard $ not (null hrs && null tit && null subtit)
   xs <- many $ try $ notFollowedBy (satisfies (== HorizontalRule)) >>
                      notFollowedBy (satisfies (isHeader (<= slideLevel))) >>
-                     anyTok
-  return $ ContentSlide tit subtit xs
+                     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
@@ -85,7 +81,7 @@ getSlideLevel = go 6
   where go least (Header n _ : x : xs)
                  | n < least && nonHOrHR x = go n xs
                  | otherwise               = go least (x:xs)
-        go least (x : xs) = go least xs
+        go least (_ : xs) = go least xs
         go least [] = least
         nonHOrHR (Header _ _) = False
         nonHOrHR (HorizontalRule) = False
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index da0389cf7..dd7a3c940 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -41,6 +41,7 @@ import Data.Char ( toLower, isPunctuation )
 import Control.Monad.State
 import Text.Pandoc.Pretty
 import System.FilePath (dropExtension)
+import Text.Pandoc.Slides
 import Text.Pandoc.Highlighting (highlight, styleToLaTeX,
                                  formatLaTeXInline, formatLaTeXBlock)
 
@@ -62,7 +63,6 @@ data WriterState =
               , stBook          :: Bool          -- true if document uses book or memoir class
               , stCsquotes      :: Bool          -- true if document uses csquotes
               , stHighlighting  :: Bool          -- true if document has highlighted code
-              , stFirstFrame    :: Bool          -- true til we've written first beamer frame
               , stIncremental   :: Bool          -- true if beamer lists should be displayed bit by bit
               , stInternalLinks :: [String]      -- list of internal link targets
               }
@@ -78,7 +78,7 @@ writeLaTeX options document =
                 stUrl = False, stGraphics = False,
                 stLHS = False, stBook = writerChapters options,
                 stCsquotes = False, stHighlighting = False,
-                stFirstFrame = True, stIncremental = writerIncremental options,
+                stIncremental = writerIncremental options,
                 stInternalLinks = [] }
 
 pandocToLaTeX :: WriterOptions -> Pandoc -> State WriterState String
@@ -200,34 +200,22 @@ inCmd :: String -> Doc -> Doc
 inCmd cmd contents = char '\\' <> text cmd <> braces contents
 
 toSlides :: [Block] -> State WriterState [Block]
-toSlides (Header n ils : bs) = do
-  tit <- inlineListToLaTeX ils
-  firstFrame <- gets stFirstFrame
-  modify $ \s -> s{ stFirstFrame = False }
+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
-  result <- ((Header n ils :) .
-             (RawBlock "latex" ("\\begin{frame}[fragile]\n" ++
-               "\\frametitle{" ++ render Nothing tit ++ "}") :))
-         `fmap` toSlides bs
-  if firstFrame
-     then return result
-     else return $ RawBlock "latex" "\\end{frame}" : result
-toSlides (HorizontalRule : Header n ils : bs) =
-  toSlides (Header n ils : bs)
-toSlides (HorizontalRule : bs) = do
-  firstFrame <- gets stFirstFrame
-  modify $ \s -> s{ stFirstFrame = False }
-  result <- (RawBlock "latex" "\\begin{frame}[fragile]" :)
-         `fmap` toSlides bs
-  if firstFrame
-     then return result
-     else return $ RawBlock "latex" "\\end{frame}" : result
-toSlides (b:bs) = (b:) `fmap` toSlides bs
-toSlides [] = do
-  firstFrame <- gets stFirstFrame
-  if firstFrame
-     then return []
-     else return [RawBlock "latex" "\\end{frame}"]
+  let slideStart = RawBlock "latex" ("\\begin{frame}[fragile]\n" ++
+            "\\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]
 
 isListBlock :: Block -> Bool
 isListBlock (BulletList _)     = True