@@ -33,7 +33,12 @@ module Text.Pandoc.Writers.HTML (
3333 writeHtml4String,
3434 writeHtml5,
3535 writeHtml5String,
36− writeHtmlStringForEPUB
36+ writeHtmlStringForEPUB,
37+ writeS5,
38+ writeSlidy,
39+ writeSlideous,
40+ writeDZSlides,
41+ writeRevealJs
3742 ) where
3843import Text.Pandoc.Definition
3944import Text.Pandoc.Walk
@@ -88,13 +93,15 @@ data WriterState = WriterState
8893 , stElement :: Bool -- ^ Processing an Element
8994 , stHtml5 :: Bool -- ^ Use HTML5
9095 , stEPUBVersion :: Maybe EPUBVersion -- ^ EPUB version if for epub
96+ , stSlideVariant :: HTMLSlideVariant
9197 }
9298
9399defaultWriterState :: WriterState
94100defaultWriterState = WriterState {stNotes= [], stMath = False, stQuotes = False,
95101 stHighlighting = False, stSecNum = [],
96102 stElement = False, stHtml5 = False,
97− stEPUBVersion = Nothing}
103+ stEPUBVersion = Nothing,
104+ stSlideVariant = NoSlides}
98105
99106-- Helpers to render HTML with the appropriate function.
100107
@@ -113,45 +120,79 @@ nl opts = if writerWrapText opts == WrapNone
113120
114121-- | Convert Pandoc document to Html 5 string.
115122writeHtml5String :: PandocMonad m => WriterOptions -> Pandoc -> m String
116−writeHtml5String = writeHtmlString' True
123+writeHtml5String = writeHtmlString'
124+ defaultWriterState{ stHtml5 = True }
117125
118126-- | Convert Pandoc document to Html 5 structure.
119127writeHtml5 :: PandocMonad m => WriterOptions -> Pandoc -> m Html
120−writeHtml5 = writeHtml' True
128+writeHtml5 = writeHtml' defaultWriterState{ stHtml5 = True }
121129
122130-- | Convert Pandoc document to Html 4 string.
123131writeHtml4String :: PandocMonad m => WriterOptions -> Pandoc -> m String
124−writeHtml4String = writeHtmlString' False
132+writeHtml4String = writeHtmlString'
133+ defaultWriterState{ stHtml5 = False }
125134
126135-- | Convert Pandoc document to Html 4 structure.
127136writeHtml4 :: PandocMonad m => WriterOptions -> Pandoc -> m Html
128−writeHtml4 = writeHtml' False
137+writeHtml4 = writeHtml' defaultWriterState{ stHtml5 = False }
129138
130139-- | Convert Pandoc document to Html appropriate for an epub version.
131140writeHtmlStringForEPUB :: PandocMonad m
132141 => EPUBVersion -> WriterOptions -> Pandoc -> m String
133−writeHtmlStringForEPUB version opts d = do
134− (body, context) <- evalStateT (pandocToHtml opts d)
142+writeHtmlStringForEPUB version = writeHtmlString'
135143 defaultWriterState{ stHtml5 = version == EPUB3,
136144 stEPUBVersion = Just version }
137− return $ case writerTemplate opts of
138− Nothing -> renderHtml body
139− Just tpl -> renderTemplate' tpl $
140− defField "body" (renderHtml body) context
141145
142−writeHtmlString' :: PandocMonad m => Bool -> WriterOptions -> Pandoc -> m String
143−writeHtmlString' html5 opts d = do
144− (body, context) <- evalStateT (pandocToHtml opts d)
145− defaultWriterState{ stHtml5 = html5 }
146+-- | Convert Pandoc document to Reveal JS HTML slide show.
147+writeRevealJs :: PandocMonad m
148+ => WriterOptions -> Pandoc -> m String
149+writeRevealJs = writeHtmlSlideShow' RevealJsSlides
150+
151+-- | Convert Pandoc document to S5 HTML slide show.
152+writeS5 :: PandocMonad m
153+ => WriterOptions -> Pandoc -> m String
154+writeS5 = writeHtmlSlideShow' S5Slides
155+
156+-- | Convert Pandoc document to Slidy HTML slide show.
157+writeSlidy :: PandocMonad m
158+ => WriterOptions -> Pandoc -> m String
159+writeSlidy = writeHtmlSlideShow' SlidySlides
160+
161+-- | Convert Pandoc document to Slideous HTML slide show.
162+writeSlideous :: PandocMonad m
163+ => WriterOptions -> Pandoc -> m String
164+writeSlideous = writeHtmlSlideShow' SlideousSlides
165+
166+-- | Convert Pandoc document to DZSlides HTML slide show.
167+writeDZSlides :: PandocMonad m
168+ => WriterOptions -> Pandoc -> m String
169+writeDZSlides = writeHtmlSlideShow' DZSlides
170+
171+writeHtmlSlideShow' :: PandocMonad m
172+ => HTMLSlideVariant -> WriterOptions -> Pandoc -> m String
173+writeHtmlSlideShow' variant = writeHtmlString'
174+ defaultWriterState{ stSlideVariant = variant
175+ , stHtml5 = case variant of
176+ RevealJsSlides -> True
177+ S5Slides -> False
178+ SlidySlides -> False
179+ DZSlides -> True
180+ SlideousSlides -> False
181+ NoSlides -> False
182+ }
183+
184+writeHtmlString' :: PandocMonad m
185+ => WriterState -> WriterOptions -> Pandoc -> m String
186+writeHtmlString' st opts d = do
187+ (body, context) <- evalStateT (pandocToHtml opts d) st
146188 return $ case writerTemplate opts of
147189 Nothing -> renderHtml body
148190 Just tpl -> renderTemplate' tpl $
149191 defField "body" (renderHtml body) context
150192
151−writeHtml' :: PandocMonad m => Bool -> WriterOptions -> Pandoc -> m Html
152−writeHtml' html5 opts d = do
153− (body, context) <- evalStateT (pandocToHtml opts d)
154− defaultWriterState{ stHtml5 = html5 }
193+writeHtml' :: PandocMonad m => WriterState -> WriterOptions -> Pandoc -> m Html
194+writeHtml' st opts d = do
195+ (body, context) <- evalStateT (pandocToHtml opts d) st
155196 return $ case writerTemplate opts of
156197 Nothing -> body
157198 Just tpl -> renderTemplate' tpl $
@@ -171,11 +212,12 @@ pandocToHtml opts (Pandoc meta blocks) = do
171212 let authsMeta = map stringifyHTML $ docAuthors meta
172213 let dateMeta = stringifyHTML $ docDate meta
173214 let slideLevel = fromMaybe (getSlideLevel blocks) $ writerSlideLevel opts
215+ slideVariant <- gets stSlideVariant
174216 let sects = hierarchicalize $
175− if writerSlideVariant opts == NoSlides
217+ if slideVariant == NoSlides
176218 then blocks
177219 else prepSlides slideLevel blocks
178− toc <- if writerTableOfContents opts
220+ toc <- if writerTableOfContents opts && slideVariant /= S5Slides
179221 then tableOfContents opts sects
180222 else return Nothing
181223 blocks' <- liftM (mconcat . intersperse (nl opts)) $
@@ -195,7 +237,7 @@ pandocToHtml opts (Pandoc meta blocks) = do
195237 MathJax url ->
196238 H.script ! A.src (toValue url)
197239 ! A.type_ "text/javascript"
198− $ case writerSlideVariant opts of
240+ $ case slideVariant of
199241 SlideousSlides ->
200242 preEscapedString
201243 "MathJax.Hub.Queue([\"Typeset\",MathJax.Hub]);"
@@ -247,21 +289,30 @@ prefixedId opts s =
247289 "" -> mempty
248290 _ -> A.id $ toValue $ writerIdentifierPrefix opts ++ s
249291
250−toList :: (Html -> Html) -> WriterOptions -> ([Html] -> Html)
292+toList :: PandocMonad m
293+ => (Html -> Html)
294+ -> WriterOptions
295+ -> [Html]
296+ -> StateT WriterState m Html
251297toList listop opts items = do
252− if (writerIncremental opts)
253− then if (writerSlideVariant opts /= RevealJsSlides)
254− then (listop $ mconcat items) ! A.class_ "incremental"
255− else listop $ mconcat $ map (! A.class_ "fragment") items
256− else listop $ mconcat items
298+ slideVariant <- gets stSlideVariant
299+ return $
300+ if (writerIncremental opts)
301+ then if (slideVariant /= RevealJsSlides)
302+ then (listop $ mconcat items) ! A.class_ "incremental"
303+ else listop $ mconcat $ map (! A.class_ "fragment") items
304+ else listop $ mconcat items
257305
258−unordList :: WriterOptions -> [Html] -> Html
306+unordList :: PandocMonad m
307+ => WriterOptions -> [Html] -> StateT WriterState m Html
259308unordList opts = toList H.ul opts . toListItems opts
260309
261−ordList :: WriterOptions -> [Html] -> Html
310+ordList :: PandocMonad m
311+ => WriterOptions -> [Html] -> StateT WriterState m Html
262312ordList opts = toList H.ol opts . toListItems opts
263313
264−defList :: WriterOptions -> [Html] -> Html
314+defList :: PandocMonad m
315+ => WriterOptions -> [Html] -> StateT WriterState m Html
265316defList opts items = toList H.dl opts (items ++ [nl opts])
266317
267318-- | Construct table of contents from list of elements.
@@ -270,9 +321,9 @@ tableOfContents _ [] = return Nothing
270321tableOfContents opts sects = do
271322 contents <- mapM (elementToListItem opts) sects
272323 let tocList = catMaybes contents
273− return $ if null tocList
274− then Nothing
275− else Just $ unordList opts tocList
324+ if null tocList
325+ then return Nothing
326+ else Just <$> unordList opts tocList
276327
277328-- | Convert section number to string
278329showSecNum :: [Int] -> String
@@ -294,11 +345,12 @@ elementToListItem opts (Sec lev num (id',classes,_) headerText subsecs)
294345 else mempty
295346 txt <- liftM (sectnum >>) $ inlineListToHtml opts $ walk deNote headerText
296347 subHeads <- mapM (elementToListItem opts) subsecs >>= return . catMaybes
297− let subList = if null subHeads
298− then mempty
299− else unordList opts subHeads
348+ subList <- if null subHeads
349+ then return mempty
350+ else unordList opts subHeads
300351 -- in reveal.js, we need #/apples, not #apples:
301− let revealSlash = ['/' | writerSlideVariant opts == RevealJsSlides]
352+ slideVariant <- gets stSlideVariant
353+ let revealSlash = ['/' | slideVariant== RevealJsSlides]
302354 return $ Just
303355 $ if null id'
304356 then (H.a $ toHtml txt) >> subList
@@ -311,7 +363,8 @@ elementToListItem _ _ = return Nothing
311363elementToHtml :: PandocMonad m => Int -> WriterOptions -> Element -> StateT WriterState m Html
312364elementToHtml _slideLevel opts (Blk block) = blockToHtml opts block
313365elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elements) = do
314− let slide = writerSlideVariant opts /= NoSlides && level <= slideLevel
366+ slideVariant <- gets stSlideVariant
367+ let slide = slideVariant /= NoSlides && level <= slideLevel
315368 let num' = zipWith (+) num (writerNumberOffset opts ++ repeat 0)
316369 modify $ \st -> st{stSecNum = num'} -- update section number
317370 html5 <- gets stHtml5
@@ -329,7 +382,7 @@ elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elemen
329382 isSec (Blk _) = False
330383 let isPause (Blk x) = x == Para [Str ".",Space,Str ".",Space,Str "."]
331384 isPause _ = False
332− let fragmentClass = case writerSlideVariant opts of
385+ let fragmentClass = case slideVariant of
333386 RevealJsSlides -> "fragment"
334387 _ -> "incremental"
335388 let inDiv xs = Blk (RawBlock (Format "html") ("<div class=\""
@@ -353,7 +406,7 @@ elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elemen
353406 else H.div
354407 let attr = (id',classes',keyvals)
355408 return $ if titleSlide
356− then (if writerSlideVariant opts == RevealJsSlides
409+ then (if slideVariant == RevealJsSlides
357410 then H5.section
358411 else id) $ mconcat $
359412 (addAttrs opts attr $ secttag $ header') : innerContents
@@ -369,10 +422,11 @@ footnoteSection :: PandocMonad m
369422 => WriterOptions -> [Html] -> StateT WriterState m Html
370423footnoteSection opts notes = do
371424 html5 <- gets stHtml5
425+ slideVariant <- gets stSlideVariant
372426 let hrtag = if html5 then H5.hr else H.hr
373427 let container x = if html5
374428 then H5.section ! A.class_ "footnotes" $ x
375− else if writerSlideVariant opts /= NoSlides
429+ else if slideVariant /= NoSlides
376430 then H.div ! A.class_ "footnotes slide" $ x
377431 else H.div ! A.class_ "footnotes" $ x
378432 return $
@@ -526,9 +580,10 @@ blockToHtml opts (Div attr@(ident, classes, kvs) bs) = do
526580 let (divtag, classes') = if html5 && "section" `elem` classes
527581 then (H5.section, filter (/= "section") classes)
528582 else (H.div, classes)
583+ slideVariant <- gets stSlideVariant
529584 return $
530585 if speakerNotes
531− then case writerSlideVariant opts of
586+ then case slideVariant of
532587 RevealJsSlides -> addAttrs opts' attr $ H5.aside $ contents'
533588 DZSlides -> (addAttrs opts' attr $ H5.div $ contents')
534589 ! (H5.customAttribute "role" "note")
@@ -565,11 +620,12 @@ blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
565620 $ H.pre $ H.code $ toHtml adjCode
566621 Just h -> modify (\st -> st{ stHighlighting = True }) >>
567622 return (addAttrs opts (id',[],keyvals) h)
568−blockToHtml opts (BlockQuote blocks) =
623+blockToHtml opts (BlockQuote blocks) = do
569624 -- in S5, treat list in blockquote specially
570625 -- if default is incremental, make it nonincremental;
571626 -- otherwise incremental
572− if writerSlideVariant opts /= NoSlides
627+ slideVariant <- gets stSlideVariant
628+ if slideVariant /= NoSlides
573629 then let inc = not (writerIncremental opts) in
574630 case blocks of
575631 [BulletList lst] -> blockToHtml (opts {writerIncremental = inc})
@@ -606,7 +662,7 @@ blockToHtml opts (Header level attr@(_,classes,_) lst) = do
606662 _ -> H.p contents'
607663blockToHtml opts (BulletList lst) = do
608664 contents <- mapM (blockListToHtml opts) lst
609− return $ unordList opts contents
665+ unordList opts contents
610666blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
611667 contents <- mapM (blockListToHtml opts) lst
612668 html5 <- gets stHtml5
@@ -632,7 +688,8 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
632688 else [A.style $ toValue $ "list-style-type: " ++
633689 numstyle']
634690 else [])
635− return $ foldl (!) (ordList opts contents) attribs
691+ l <- ordList opts contents
692+ return $ foldl (!) l attribs
636693blockToHtml opts (DefinitionList lst) = do
637694 contents <- mapM (\(term, defs) ->
638695 do term' <- if null term
@@ -642,7 +699,7 @@ blockToHtml opts (DefinitionList lst) = do
642699 blockListToHtml opts) defs
643700 return $ mconcat $ nl opts : term' : nl opts :
644701 intersperse (nl opts) defs') lst
645− return $ defList opts contents
702+ defList opts contents
646703blockToHtml opts (Table capt aligns widths headers rows') = do
647704 captionDoc <- if null capt
648705 then return mempty
@@ -878,9 +935,10 @@ inlineToHtml opts inline = do
878935 lift $ obfuscateLink opts attr linkText s
879936 (Link attr txt (s,tit)) -> do
880937 linkText <- inlineListToHtml opts txt
938+ slideVariant <- gets stSlideVariant
881939 let s' = case s of
882− '#':xs | writerSlideVariant opts ==
883− RevealJsSlides -> '#':'/':xs
940+ '#':xs | slideVariant == RevealJsSlides
941+ -> '#':'/':xs
884942 _ -> s
885943 let link = H.a ! A.href (toValue s') $ linkText
886944 let link' = if txt == [Str (unEscapeString s)]
@@ -913,8 +971,8 @@ inlineToHtml opts inline = do
913971 epubVersion <- gets stEPUBVersion
914972 -- push contents onto front of notes
915973 modify $ \st -> st {stNotes = (htmlContents:notes)}
916− let revealSlash = ['/' | writerSlideVariant opts
917− == RevealJsSlides]
974+ slideVariant <- gets stSlideVariant
975+ let revealSlash = ['/' | slideVariant == RevealJsSlides]
918976 let link = H.a ! A.href (toValue $ "#" ++
919977 revealSlash ++
920978 writerIdentifierPrefix opts ++ "fn" ++ ref)