From a11b5309351cfa813face2d07cdbc32b1fa6cf0f Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Thu, 22 Jul 2010 22:58:48 -0700 Subject: Moved s5 writing from S5 module to HTML. Now s5 is handled in more or less the same way as slidy, as a variant of HTML. --- src/Text/Pandoc.hs | 2 -- src/Text/Pandoc/Templates.hs | 1 - src/Text/Pandoc/Writers/HTML.hs | 10 +++---- src/Text/Pandoc/Writers/S5.hs | 65 +---------------------------------------- 4 files changed, 5 insertions(+), 73 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs index a4caf106d..f0d679dae 100644 --- a/src/Text/Pandoc.hs +++ b/src/Text/Pandoc.hs @@ -80,8 +80,6 @@ module Text.Pandoc , writeTexinfo , writeHtml , writeHtmlString - , writeS5 - , writeS5String , writeDocbook , writeOpenDocument , writeMan diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs index 372954ae3..c8ddc3abf 100644 --- a/src/Text/Pandoc/Templates.hs +++ b/src/Text/Pandoc/Templates.hs @@ -83,7 +83,6 @@ getDefaultTemplate :: (Maybe FilePath) -- ^ User data directory to search first -> String -- ^ Name of writer -> IO (Either E.IOException String) getDefaultTemplate _ "native" = return $ Right "" -getDefaultTemplate user "s5" = getDefaultTemplate user "html" getDefaultTemplate user "odt" = getDefaultTemplate user "opendocument" getDefaultTemplate user writer = do let format = takeWhile (/='+') writer -- strip off "+lhs" if present diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 09af03f4e..abe7e3a42 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -117,12 +117,10 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do (Header 1 _ : _) -> [] _ -> [RawHtml "
\n"] blocks' <- liftM toHtmlFromList $ - case writerSlideVariant opts of - SlidySlides -> mapM (blockToHtml opts) $ - preamble ++ - cutUp blocks ++ - [RawHtml "
"] - _ -> mapM (elementToHtml opts) sects + if writerSlideVariant opts `elem` [SlidySlides, S5Slides] + then mapM (blockToHtml opts) $ preamble ++ + cutUp blocks ++ [RawHtml ""] + else mapM (elementToHtml opts) sects st <- get let notes = reverse (stNotes st) let thebody = blocks' +++ footnoteSection notes diff --git a/src/Text/Pandoc/Writers/S5.hs b/src/Text/Pandoc/Writers/S5.hs index d2dab07a3..a439363f1 100644 --- a/src/Text/Pandoc/Writers/S5.hs +++ b/src/Text/Pandoc/Writers/S5.hs @@ -30,20 +30,13 @@ Definitions for creation of S5 powerpoint-like HTML. -} module Text.Pandoc.Writers.S5 ( -- * Header includes - s5HeaderIncludes, - s5Meta, - s5Links, - -- * Functions - writeS5, - writeS5String, - insertS5Structure + s5HeaderIncludes ) where import Text.Pandoc.Shared ( WriterOptions, readDataFile ) import Text.Pandoc.Writers.HTML ( writeHtml, writeHtmlString ) import Text.Pandoc.Definition import Text.XHtml.Strict import System.FilePath ( () ) -import Data.List ( intercalate ) s5HeaderIncludes :: Maybe FilePath -> IO String s5HeaderIncludes datadir = do @@ -71,59 +64,3 @@ s5CSS datadir = do s5PrintCSS <- readDataFile datadir $ "s5" "default" "print.css" return $ "\n\n\n\n" -s5Links :: String -s5Links = "\n\n\n\n\n\n\n" - --- | Converts Pandoc document to an S5 HTML presentation (Html structure). -writeS5 :: WriterOptions -> Pandoc -> Html -writeS5 options = (writeHtml options) . insertS5Structure - --- | Converts Pandoc document to an S5 HTML presentation (string). -writeS5String :: WriterOptions -> Pandoc -> String -writeS5String options = (writeHtmlString options) . insertS5Structure - --- | Inserts HTML needed for an S5 presentation (e.g. around slides). -layoutDiv :: [Inline] -- ^ Title of document (for header or footer) - -> [Inline] -- ^ Date of document (for header or footer) - -> [Block] -- ^ List of block elements returned -layoutDiv title' date = [(RawHtml "
\n
\n
\n
\n
\n"), (Header 1 date), (Header 2 title'), (RawHtml "
\n
\n")] - -presentationStart :: Block -presentationStart = RawHtml "
\n\n" - -presentationEnd :: Block -presentationEnd = RawHtml "
\n" - -slideStart :: Block -slideStart = RawHtml "
\n" - -slideEnd :: Block -slideEnd = RawHtml "
\n" - --- | Returns 'True' if block is a Header 1. -isH1 :: Block -> Bool -isH1 (Header 1 _) = True -isH1 _ = False - --- | Insert HTML around sections to make individual slides. -insertSlides :: Bool -> [Block] -> [Block] -insertSlides beginning blocks = - let (beforeHead, rest) = break isH1 blocks - in case rest of - [] -> beforeHead ++ [slideEnd | not beginning] - (h:t) -> beforeHead ++ [slideEnd | not beginning] ++ - (slideStart : h : insertSlides False t) - --- | Insert blocks into 'Pandoc' for slide structure. -insertS5Structure :: Pandoc -> Pandoc -insertS5Structure (Pandoc meta' []) = Pandoc meta' [] -insertS5Structure (Pandoc (Meta title' authors date) blocks) = - let slides = insertSlides True blocks - firstSlide = if not (null title') - then [slideStart, (Header 1 title'), - (Header 3 (intercalate [LineBreak] authors)), - (Header 4 date), slideEnd] - else [] - newBlocks = (layoutDiv title' date) ++ presentationStart:firstSlide ++ - slides ++ [presentationEnd] - in Pandoc (Meta title' authors date) newBlocks -- cgit v1.2.3