@@ -33,7 +33,12 @@ module Text.Pandoc.Writers.HTML (
33 writeHtml4String,
33 writeHtml4String,
34 writeHtml5,
34 writeHtml5,
35 writeHtml5String,
35 writeHtml5String,
36− writeHtmlStringForEPUB
36+ writeHtmlStringForEPUB,
38import Text.Pandoc.Definition
43import Text.Pandoc.Definition
39import Text.Pandoc.Walk
44import Text.Pandoc.Walk
@@ -88,13 +93,15 @@ data WriterState = WriterState
88 , stElement :: Bool -- ^ Processing an Element
93 , stElement :: Bool -- ^ Processing an Element
89 , stHtml5 :: Bool -- ^ Use HTML5
94 , stHtml5 :: Bool -- ^ Use HTML5
90 , stEPUBVersion :: Maybe EPUBVersion -- ^ EPUB version if for epub
95 , stEPUBVersion :: Maybe EPUBVersion -- ^ EPUB version if for epub
96+ , stSlideVariant :: HTMLSlideVariant
93defaultWriterState :: WriterState
99defaultWriterState :: WriterState
94defaultWriterState = WriterState {stNotes= [], stMath = False, stQuotes = False,
100defaultWriterState = WriterState {stNotes= [], stMath = False, stQuotes = False,
95 stHighlighting = False, stSecNum = [],
101 stHighlighting = False, stSecNum = [],
96 stElement = False, stHtml5 = False,
102 stElement = False, stHtml5 = False,
97− stEPUBVersion = Nothing}
103+ stEPUBVersion = Nothing,
104+ stSlideVariant = NoSlides}
99-- Helpers to render HTML with the appropriate function.
106-- Helpers to render HTML with the appropriate function.
@@ -113,45 +120,79 @@ nl opts = if writerWrapText opts == WrapNone
114-- | Convert Pandoc document to Html 5 string.
121-- | Convert Pandoc document to Html 5 string.
115writeHtml5String :: PandocMonad m => WriterOptions -> Pandoc -> m String
122writeHtml5String :: PandocMonad m => WriterOptions -> Pandoc -> m String
116−writeHtml5String = writeHtmlString' True
123+writeHtml5String = writeHtmlString'
124+ defaultWriterState{ stHtml5 = True }
118-- | Convert Pandoc document to Html 5 structure.
126-- | Convert Pandoc document to Html 5 structure.
119writeHtml5 :: PandocMonad m => WriterOptions -> Pandoc -> m Html
127writeHtml5 :: PandocMonad m => WriterOptions -> Pandoc -> m Html
120−writeHtml5 = writeHtml' True
128+writeHtml5 = writeHtml' defaultWriterState{ stHtml5 = True }
122-- | Convert Pandoc document to Html 4 string.
130-- | Convert Pandoc document to Html 4 string.
123writeHtml4String :: PandocMonad m => WriterOptions -> Pandoc -> m String
131writeHtml4String :: PandocMonad m => WriterOptions -> Pandoc -> m String
124−writeHtml4String = writeHtmlString' False
132+writeHtml4String = writeHtmlString'
133+ defaultWriterState{ stHtml5 = False }
126-- | Convert Pandoc document to Html 4 structure.
135-- | Convert Pandoc document to Html 4 structure.
127writeHtml4 :: PandocMonad m => WriterOptions -> Pandoc -> m Html
136writeHtml4 :: PandocMonad m => WriterOptions -> Pandoc -> m Html
128−writeHtml4 = writeHtml' False
137+writeHtml4 = writeHtml' defaultWriterState{ stHtml5 = False }
130-- | Convert Pandoc document to Html appropriate for an epub version.
139-- | Convert Pandoc document to Html appropriate for an epub version.
131writeHtmlStringForEPUB :: PandocMonad m
140writeHtmlStringForEPUB :: PandocMonad m
132 => EPUBVersion -> WriterOptions -> Pandoc -> m String
141 => EPUBVersion -> WriterOptions -> Pandoc -> m String
133−writeHtmlStringForEPUB version opts d = do
142+writeHtmlStringForEPUB version = writeHtmlString'
134− (body, context) <- evalStateT (pandocToHtml opts d)
135 defaultWriterState{ stHtml5 = version == EPUB3,
143 defaultWriterState{ stHtml5 = version == EPUB3,
136 stEPUBVersion = Just version }
144 stEPUBVersion = Just version }
137− return $ case writerTemplate opts of
138− Nothing -> renderHtml body
139− Just tpl -> renderTemplate' tpl $
140− defField "body" (renderHtml body) context
146+-- | Convert Pandoc document to Reveal JS HTML slide show.
147+writeRevealJs :: PandocMonad m
148+ => WriterOptions -> Pandoc -> m String
149+writeRevealJs = writeHtmlSlideShow' RevealJsSlides
151+-- | Convert Pandoc document to S5 HTML slide show.
152+writeS5 :: PandocMonad m
153+ => WriterOptions -> Pandoc -> m String
154+writeS5 = writeHtmlSlideShow' S5Slides
156+-- | Convert Pandoc document to Slidy HTML slide show.
157+writeSlidy :: PandocMonad m
158+ => WriterOptions -> Pandoc -> m String
159+writeSlidy = writeHtmlSlideShow' SlidySlides
161+-- | Convert Pandoc document to Slideous HTML slide show.
162+writeSlideous :: PandocMonad m
163+ => WriterOptions -> Pandoc -> m String
164+writeSlideous = writeHtmlSlideShow' SlideousSlides
166+-- | Convert Pandoc document to DZSlides HTML slide show.
167+writeDZSlides :: PandocMonad m
168+ => WriterOptions -> Pandoc -> m String
169+writeDZSlides = writeHtmlSlideShow' DZSlides
171+writeHtmlSlideShow' :: PandocMonad m
142−writeHtmlString' :: PandocMonad m => Bool -> WriterOptions -> Pandoc -> m String
172+ => HTMLSlideVariant -> WriterOptions -> Pandoc -> m String
143−writeHtmlString' html5 opts d = do
173+writeHtmlSlideShow' variant = writeHtmlString'
174+ defaultWriterState{ stSlideVariant = variant
175+ , stHtml5 = case variant of
176+ RevealJsSlides -> True
178+ SlidySlides -> False
180+ SlideousSlides -> False
184+writeHtmlString' :: PandocMonad m
185+ => WriterState -> WriterOptions -> Pandoc -> m String
186+writeHtmlString' st opts d = do
144− (body, context) <- evalStateT (pandocToHtml opts d)
187+ (body, context) <- evalStateT (pandocToHtml opts d) st
145− defaultWriterState{ stHtml5 = html5 }
146 return $ case writerTemplate opts of
188 return $ case writerTemplate opts of
147 Nothing -> renderHtml body
189 Nothing -> renderHtml body
148 Just tpl -> renderTemplate' tpl $
190 Just tpl -> renderTemplate' tpl $
149 defField "body" (renderHtml body) context
191 defField "body" (renderHtml body) context
151−writeHtml' :: PandocMonad m => Bool -> WriterOptions -> Pandoc -> m Html
193+writeHtml' :: PandocMonad m => WriterState -> WriterOptions -> Pandoc -> m Html
152−writeHtml' html5 opts d = do
194+writeHtml' st opts d = do
153− (body, context) <- evalStateT (pandocToHtml opts d)
195+ (body, context) <- evalStateT (pandocToHtml opts d) st
154− defaultWriterState{ stHtml5 = html5 }
155 return $ case writerTemplate opts of
196 return $ case writerTemplate opts of
156 Nothing -> body
197 Nothing -> body
157 Just tpl -> renderTemplate' tpl $
198 Just tpl -> renderTemplate' tpl $
@@ -171,11 +212,12 @@ pandocToHtml opts (Pandoc meta blocks) = do
171 let authsMeta = map stringifyHTML $ docAuthors meta
212 let authsMeta = map stringifyHTML $ docAuthors meta
172 let dateMeta = stringifyHTML $ docDate meta
213 let dateMeta = stringifyHTML $ docDate meta
173 let slideLevel = fromMaybe (getSlideLevel blocks) $ writerSlideLevel opts
214 let slideLevel = fromMaybe (getSlideLevel blocks) $ writerSlideLevel opts
215+ slideVariant <- gets stSlideVariant
174 let sects = hierarchicalize $
216 let sects = hierarchicalize $
175− if writerSlideVariant opts == NoSlides
217+ if slideVariant == NoSlides
176 then blocks
218 then blocks
177 else prepSlides slideLevel blocks
219 else prepSlides slideLevel blocks
178− toc <- if writerTableOfContents opts
220+ toc <- if writerTableOfContents opts && slideVariant /= S5Slides
179 then tableOfContents opts sects
221 then tableOfContents opts sects
180 else return Nothing
222 else return Nothing
181 blocks' <- liftM (mconcat . intersperse (nl opts)) $
223 blocks' <- liftM (mconcat . intersperse (nl opts)) $
@@ -195,7 +237,7 @@ pandocToHtml opts (Pandoc meta blocks) = do
195 MathJax url ->
237 MathJax url ->
196 H.script ! A.src (toValue url)
238 H.script ! A.src (toValue url)
197 ! A.type_ "text/javascript"
239 ! A.type_ "text/javascript"
198− $ case writerSlideVariant opts of
240+ $ case slideVariant of
199 SlideousSlides ->
241 SlideousSlides ->
200 preEscapedString
242 preEscapedString
201 "MathJax.Hub.Queue([\"Typeset\",MathJax.Hub]);"
243 "MathJax.Hub.Queue([\"Typeset\",MathJax.Hub]);"
@@ -247,21 +289,30 @@ prefixedId opts s =
247 "" -> mempty
289 "" -> mempty
248 _ -> A.id $ toValue $ writerIdentifierPrefix opts ++ s
290 _ -> A.id $ toValue $ writerIdentifierPrefix opts ++ s
292+toList :: PandocMonad m
250−toList :: (Html -> Html) -> WriterOptions -> ([Html] -> Html)
294+ -> WriterOptions
296+ -> StateT WriterState m Html
251toList listop opts items = do
297toList listop opts items = do
298+ slideVariant <- gets stSlideVariant
252− if (writerIncremental opts)
300+ if (writerIncremental opts)
253− then if (writerSlideVariant opts /= RevealJsSlides)
301+ then if (slideVariant /= RevealJsSlides)
254− then (listop $ mconcat items) ! A.class_ "incremental"
302+ then (listop $ mconcat items) ! A.class_ "incremental"
255− else listop $ mconcat $ map (! A.class_ "fragment") items
303+ else listop $ mconcat $ map (! A.class_ "fragment") items
256− else listop $ mconcat items
304+ else listop $ mconcat items
306+unordList :: PandocMonad m
258−unordList :: WriterOptions -> [Html] -> Html
307+ => WriterOptions -> [Html] -> StateT WriterState m Html
259unordList opts = toList H.ul opts . toListItems opts
308unordList opts = toList H.ul opts . toListItems opts
310+ordList :: PandocMonad m
261−ordList :: WriterOptions -> [Html] -> Html
311+ => WriterOptions -> [Html] -> StateT WriterState m Html
262ordList opts = toList H.ol opts . toListItems opts
312ordList opts = toList H.ol opts . toListItems opts
314+defList :: PandocMonad m
264−defList :: WriterOptions -> [Html] -> Html
315+ => WriterOptions -> [Html] -> StateT WriterState m Html
265defList opts items = toList H.dl opts (items ++ [nl opts])
316defList opts items = toList H.dl opts (items ++ [nl opts])
267-- | Construct table of contents from list of elements.
318-- | Construct table of contents from list of elements.
@@ -270,9 +321,9 @@ tableOfContents _ [] = return Nothing
270tableOfContents opts sects = do
321tableOfContents opts sects = do
271 contents <- mapM (elementToListItem opts) sects
322 contents <- mapM (elementToListItem opts) sects
272 let tocList = catMaybes contents
323 let tocList = catMaybes contents
273− return $ if null tocList
324+ if null tocList
274− then Nothing
325+ then return Nothing
275− else Just $ unordList opts tocList
326+ else Just <$> unordList opts tocList
277-- | Convert section number to string
328-- | Convert section number to string
278showSecNum :: [Int] -> String
329showSecNum :: [Int] -> String
@@ -294,11 +345,12 @@ elementToListItem opts (Sec lev num (id',classes,_) headerText subsecs)
294 else mempty
345 else mempty
295 txt <- liftM (sectnum >>) $ inlineListToHtml opts $ walk deNote headerText
346 txt <- liftM (sectnum >>) $ inlineListToHtml opts $ walk deNote headerText
296 subHeads <- mapM (elementToListItem opts) subsecs >>= return . catMaybes
347 subHeads <- mapM (elementToListItem opts) subsecs >>= return . catMaybes
297− let subList = if null subHeads
348+ subList <- if null subHeads
298− then mempty
349+ then return mempty
299− else unordList opts subHeads
350+ else unordList opts subHeads
300 -- in reveal.js, we need #/apples, not #apples:
351 -- in reveal.js, we need #/apples, not #apples:
352+ slideVariant <- gets stSlideVariant
301− let revealSlash = ['/' | writerSlideVariant opts == RevealJsSlides]
353+ let revealSlash = ['/' | slideVariant== RevealJsSlides]
302 return $ Just
354 return $ Just
303 $ if null id'
355 $ if null id'
304 then (H.a $ toHtml txt) >> subList
356 then (H.a $ toHtml txt) >> subList
@@ -311,7 +363,8 @@ elementToListItem _ _ = return Nothing
311elementToHtml :: PandocMonad m => Int -> WriterOptions -> Element -> StateT WriterState m Html
363elementToHtml :: PandocMonad m => Int -> WriterOptions -> Element -> StateT WriterState m Html
312elementToHtml _slideLevel opts (Blk block) = blockToHtml opts block
364elementToHtml _slideLevel opts (Blk block) = blockToHtml opts block
313elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elements) = do
365elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elements) = do
366+ slideVariant <- gets stSlideVariant
314− let slide = writerSlideVariant opts /= NoSlides && level <= slideLevel
367+ let slide = slideVariant /= NoSlides && level <= slideLevel
315 let num' = zipWith (+) num (writerNumberOffset opts ++ repeat 0)
368 let num' = zipWith (+) num (writerNumberOffset opts ++ repeat 0)
316 modify $ \st -> st{stSecNum = num'} -- update section number
369 modify $ \st -> st{stSecNum = num'} -- update section number
317 html5 <- gets stHtml5
370 html5 <- gets stHtml5
@@ -329,7 +382,7 @@ elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elemen
329 isSec (Blk _) = False
382 isSec (Blk _) = False
330 let isPause (Blk x) = x == Para [Str ".",Space,Str ".",Space,Str "."]
383 let isPause (Blk x) = x == Para [Str ".",Space,Str ".",Space,Str "."]
331 isPause _ = False
384 isPause _ = False
332− let fragmentClass = case writerSlideVariant opts of
385+ let fragmentClass = case slideVariant of
333 RevealJsSlides -> "fragment"
386 RevealJsSlides -> "fragment"
334 _ -> "incremental"
387 _ -> "incremental"
335 let inDiv xs = Blk (RawBlock (Format "html") ("<div class=\""
388 let inDiv xs = Blk (RawBlock (Format "html") ("<div class=\""
@@ -353,7 +406,7 @@ elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elemen
353 else H.div
406 else H.div
354 let attr = (id',classes',keyvals)
407 let attr = (id',classes',keyvals)
355 return $ if titleSlide
408 return $ if titleSlide
356− then (if writerSlideVariant opts == RevealJsSlides
409+ then (if slideVariant == RevealJsSlides
357 then H5.section
410 then H5.section
358 else id) $ mconcat $
411 else id) $ mconcat $
359 (addAttrs opts attr $ secttag $ header') : innerContents
412 (addAttrs opts attr $ secttag $ header') : innerContents
@@ -369,10 +422,11 @@ footnoteSection :: PandocMonad m
369 => WriterOptions -> [Html] -> StateT WriterState m Html
422 => WriterOptions -> [Html] -> StateT WriterState m Html
370footnoteSection opts notes = do
423footnoteSection opts notes = do
371 html5 <- gets stHtml5
424 html5 <- gets stHtml5
425+ slideVariant <- gets stSlideVariant
372 let hrtag = if html5 then H5.hr else H.hr
426 let hrtag = if html5 then H5.hr else H.hr
373 let container x = if html5
427 let container x = if html5
374 then H5.section ! A.class_ "footnotes" $ x
428 then H5.section ! A.class_ "footnotes" $ x
375− else if writerSlideVariant opts /= NoSlides
429+ else if slideVariant /= NoSlides
376 then H.div ! A.class_ "footnotes slide" $ x
430 then H.div ! A.class_ "footnotes slide" $ x
377 else H.div ! A.class_ "footnotes" $ x
431 else H.div ! A.class_ "footnotes" $ x
@@ -526,9 +580,10 @@ blockToHtml opts (Div attr@(ident, classes, kvs) bs) = do
526 let (divtag, classes') = if html5 && "section" `elem` classes
580 let (divtag, classes') = if html5 && "section" `elem` classes
527 then (H5.section, filter (/= "section") classes)
581 then (H5.section, filter (/= "section") classes)
528 else (H.div, classes)
582 else (H.div, classes)
583+ slideVariant <- gets stSlideVariant
530 if speakerNotes
585 if speakerNotes
531− then case writerSlideVariant opts of
586+ then case slideVariant of
532 RevealJsSlides -> addAttrs opts' attr $ H5.aside $ contents'
587 RevealJsSlides -> addAttrs opts' attr $ H5.aside $ contents'
533 DZSlides -> (addAttrs opts' attr $ H5.div $ contents')
588 DZSlides -> (addAttrs opts' attr $ H5.div $ contents')
534 ! (H5.customAttribute "role" "note")
589 ! (H5.customAttribute "role" "note")
@@ -565,11 +620,12 @@ blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
565 $ H.pre $ H.code $ toHtml adjCode
620 $ H.pre $ H.code $ toHtml adjCode
566 Just h -> modify (\st -> st{ stHighlighting = True }) >>
621 Just h -> modify (\st -> st{ stHighlighting = True }) >>
567 return (addAttrs opts (id',[],keyvals) h)
622 return (addAttrs opts (id',[],keyvals) h)
568−blockToHtml opts (BlockQuote blocks) =
623+blockToHtml opts (BlockQuote blocks) = do
569 -- in S5, treat list in blockquote specially
624 -- in S5, treat list in blockquote specially
570 -- if default is incremental, make it nonincremental;
625 -- if default is incremental, make it nonincremental;
571 -- otherwise incremental
626 -- otherwise incremental
572− if writerSlideVariant opts /= NoSlides
627+ slideVariant <- gets stSlideVariant
628+ if slideVariant /= NoSlides
573 then let inc = not (writerIncremental opts) in
629 then let inc = not (writerIncremental opts) in
574 case blocks of
630 case blocks of
575 [BulletList lst] -> blockToHtml (opts {writerIncremental = inc})
631 [BulletList lst] -> blockToHtml (opts {writerIncremental = inc})
@@ -606,7 +662,7 @@ blockToHtml opts (Header level attr@(_,classes,_) lst) = do
606 _ -> H.p contents'
662 _ -> H.p contents'
607blockToHtml opts (BulletList lst) = do
663blockToHtml opts (BulletList lst) = do
608 contents <- mapM (blockListToHtml opts) lst
664 contents <- mapM (blockListToHtml opts) lst
609− return $ unordList opts contents
665+ unordList opts contents
610blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
666blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
611 contents <- mapM (blockListToHtml opts) lst
667 contents <- mapM (blockListToHtml opts) lst
612 html5 <- gets stHtml5
668 html5 <- gets stHtml5
@@ -632,7 +688,8 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
632 else [A.style $ toValue $ "list-style-type: " ++
688 else [A.style $ toValue $ "list-style-type: " ++
633 numstyle']
689 numstyle']
691+ l <- ordList opts contents
635− return $ foldl (!) (ordList opts contents) attribs
692+ return $ foldl (!) l attribs
636blockToHtml opts (DefinitionList lst) = do
693blockToHtml opts (DefinitionList lst) = do
637 contents <- mapM (\(term, defs) ->
694 contents <- mapM (\(term, defs) ->
638 do term' <- if null term
695 do term' <- if null term
@@ -642,7 +699,7 @@ blockToHtml opts (DefinitionList lst) = do
642 blockListToHtml opts) defs
699 blockListToHtml opts) defs
643 return $ mconcat $ nl opts : term' : nl opts :
700 return $ mconcat $ nl opts : term' : nl opts :
644 intersperse (nl opts) defs') lst
701 intersperse (nl opts) defs') lst
645− return $ defList opts contents
702+ defList opts contents
646blockToHtml opts (Table capt aligns widths headers rows') = do
703blockToHtml opts (Table capt aligns widths headers rows') = do
647 captionDoc <- if null capt
704 captionDoc <- if null capt
648 then return mempty
705 then return mempty
@@ -878,9 +935,10 @@ inlineToHtml opts inline = do
878 lift $ obfuscateLink opts attr linkText s
935 lift $ obfuscateLink opts attr linkText s
879 (Link attr txt (s,tit)) -> do
936 (Link attr txt (s,tit)) -> do
880 linkText <- inlineListToHtml opts txt
937 linkText <- inlineListToHtml opts txt
938+ slideVariant <- gets stSlideVariant
881 let s' = case s of
939 let s' = case s of
882− '#':xs | writerSlideVariant opts ==
883− RevealJsSlides -> '#':'/':xs
940+ '#':xs | slideVariant == RevealJsSlides
885 let link = H.a ! A.href (toValue s') $ linkText
943 let link = H.a ! A.href (toValue s') $ linkText
886 let link' = if txt == [Str (unEscapeString s)]
944 let link' = if txt == [Str (unEscapeString s)]
@@ -913,8 +971,8 @@ inlineToHtml opts inline = do
913 epubVersion <- gets stEPUBVersion
971 epubVersion <- gets stEPUBVersion
914 -- push contents onto front of notes
972 -- push contents onto front of notes
915 modify $ \st -> st {stNotes = (htmlContents:notes)}
973 modify $ \st -> st {stNotes = (htmlContents:notes)}
916− let revealSlash = ['/' | writerSlideVariant opts
974+ slideVariant <- gets stSlideVariant
917− == RevealJsSlides]
975+ let revealSlash = ['/' | slideVariant == RevealJsSlides]
918 let link = H.a ! A.href (toValue $ "#" ++
976 let link = H.a ! A.href (toValue $ "#" ++
919 revealSlash ++
977 revealSlash ++
920 writerIdentifierPrefix opts ++ "fn" ++ ref)
978 writerIdentifierPrefix opts ++ "fn" ++ ref)