Added basic support for reveal.js.
Support unordered and ordered lists with "fragment" elements. Modified by JGM to remove the --reveal_js-url command-line option. Instead use -V reveal_js-url=... as with slidy and the other slide formats. Also cleaned up the list code in the HTML writer.
This commit is contained in:
parent
ff9af6c9e5
commit
6b53a905c4
6 changed files with 22 additions and 18 deletions
|
@ -1 +1 @@
|
||||||
Subproject commit 7ac22fea6399ce6fdac093fa9d163d09fc28d440
|
Subproject commit 85ec1ef277e914576af176b5ab43bcc27fa51936
|
|
@ -1113,7 +1113,7 @@ main = do
|
||||||
>>= writerFn outputFile . handleEntities
|
>>= writerFn outputFile . handleEntities
|
||||||
where htmlFormat = writerName' `elem`
|
where htmlFormat = writerName' `elem`
|
||||||
["html","html+lhs","html5","html5+lhs",
|
["html","html+lhs","html5","html5+lhs",
|
||||||
"s5","slidy","slideous","dzslides"]
|
"s5","slidy","slideous","dzslides","reveal_js"]
|
||||||
selfcontain = if selfContained && htmlFormat
|
selfcontain = if selfContained && htmlFormat
|
||||||
then makeSelfContained datadir
|
then makeSelfContained datadir
|
||||||
else return
|
else return
|
||||||
|
|
|
@ -231,6 +231,9 @@ writers = [
|
||||||
,("dzslides" , PureStringWriter $ \o ->
|
,("dzslides" , PureStringWriter $ \o ->
|
||||||
writeHtmlString o{ writerSlideVariant = DZSlides
|
writeHtmlString o{ writerSlideVariant = DZSlides
|
||||||
, writerHtml5 = True })
|
, writerHtml5 = True })
|
||||||
|
,("reveal_js" , PureStringWriter $ \o ->
|
||||||
|
writeHtmlString o{ writerSlideVariant = RevealJsSlides
|
||||||
|
, writerHtml5 = True })
|
||||||
,("docbook" , PureStringWriter writeDocbook)
|
,("docbook" , PureStringWriter writeDocbook)
|
||||||
,("opml" , PureStringWriter writeOPML)
|
,("opml" , PureStringWriter writeOPML)
|
||||||
,("opendocument" , PureStringWriter writeOpenDocument)
|
,("opendocument" , PureStringWriter writeOpenDocument)
|
||||||
|
|
|
@ -255,6 +255,7 @@ data HTMLSlideVariant = S5Slides
|
||||||
| SlidySlides
|
| SlidySlides
|
||||||
| SlideousSlides
|
| SlideousSlides
|
||||||
| DZSlides
|
| DZSlides
|
||||||
|
| RevealJsSlides
|
||||||
| NoSlides
|
| NoSlides
|
||||||
deriving (Show, Read, Eq)
|
deriving (Show, Read, Eq)
|
||||||
|
|
||||||
|
|
|
@ -26,7 +26,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||||
Portability : portable
|
Portability : portable
|
||||||
|
|
||||||
Utility functions for splitting documents into slides for slide
|
Utility functions for splitting documents into slides for slide
|
||||||
show formats (dzslides, s5, slidy, slideous, beamer).
|
show formats (dzslides, reveal_js, s5, slidy, slideous, beamer).
|
||||||
-}
|
-}
|
||||||
module Text.Pandoc.Slides ( getSlideLevel, prepSlides ) where
|
module Text.Pandoc.Slides ( getSlideLevel, prepSlides ) where
|
||||||
import Text.Pandoc.Definition
|
import Text.Pandoc.Definition
|
||||||
|
|
|
@ -224,13 +224,20 @@ prefixedId opts s =
|
||||||
"" -> mempty
|
"" -> mempty
|
||||||
_ -> A.id $ toValue $ writerIdentifierPrefix opts ++ s
|
_ -> A.id $ toValue $ writerIdentifierPrefix opts ++ s
|
||||||
|
|
||||||
-- | Replacement for Text.XHtml's unordList.
|
toList :: (Html -> Html) -> WriterOptions -> ([Html] -> Html)
|
||||||
unordList :: WriterOptions -> ([Html] -> Html)
|
toList listop opts items = do
|
||||||
unordList opts items = H.ul $ mconcat $ toListItems opts items
|
let items' = toListItems opts items
|
||||||
|
if (writerIncremental opts)
|
||||||
|
then if (writerSlideVariant opts /= RevealJsSlides)
|
||||||
|
then (listop $ mconcat items') ! A.class_ "incremental"
|
||||||
|
else listop $ mconcat $ map (! A.class_ "fragment") items'
|
||||||
|
else listop $ mconcat items'
|
||||||
|
|
||||||
-- | Replacement for Text.XHtml's ordList.
|
unordList :: WriterOptions -> [Html] -> Html
|
||||||
ordList :: WriterOptions -> ([Html] -> Html)
|
unordList = toList H.ul
|
||||||
ordList opts items = H.ol $ mconcat $ toListItems opts items
|
|
||||||
|
ordList :: WriterOptions -> [Html] -> Html
|
||||||
|
ordList = toList H.ol
|
||||||
|
|
||||||
-- | Construct table of contents from list of elements.
|
-- | Construct table of contents from list of elements.
|
||||||
tableOfContents :: WriterOptions -> [Element] -> State WriterState (Maybe Html)
|
tableOfContents :: WriterOptions -> [Element] -> State WriterState (Maybe Html)
|
||||||
|
@ -476,18 +483,11 @@ blockToHtml opts (Header level (ident,_,_) lst) = do
|
||||||
_ -> H.p contents''
|
_ -> H.p contents''
|
||||||
blockToHtml opts (BulletList lst) = do
|
blockToHtml opts (BulletList lst) = do
|
||||||
contents <- mapM (blockListToHtml opts) lst
|
contents <- mapM (blockListToHtml opts) lst
|
||||||
let lst' = unordList opts contents
|
return $ unordList opts contents
|
||||||
let lst'' = if writerIncremental opts
|
|
||||||
then lst' ! A.class_ "incremental"
|
|
||||||
else lst'
|
|
||||||
return lst''
|
|
||||||
blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
|
blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
|
||||||
contents <- mapM (blockListToHtml opts) lst
|
contents <- mapM (blockListToHtml opts) lst
|
||||||
let numstyle' = camelCaseToHyphenated $ show numstyle
|
let numstyle' = camelCaseToHyphenated $ show numstyle
|
||||||
let attribs = (if writerIncremental opts
|
let attribs = (if startnum /= 1
|
||||||
then [A.class_ "incremental"]
|
|
||||||
else []) ++
|
|
||||||
(if startnum /= 1
|
|
||||||
then [A.start $ toValue startnum]
|
then [A.start $ toValue startnum]
|
||||||
else []) ++
|
else []) ++
|
||||||
(if numstyle /= DefaultStyle
|
(if numstyle /= DefaultStyle
|
||||||
|
|
Loading…
Reference in a new issue