aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers/HTML.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Writers/HTML.hs')
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs205
1 files changed, 117 insertions, 88 deletions
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 1a00c7660..a2778ea97 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE OverloadedStrings, CPP, ViewPatterns #-}
+{-# LANGUAGE OverloadedStrings, CPP, ViewPatterns, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}
{-
-Copyright (C) 2006-2014 John MacFarlane <jgm@berkeley.edu>
+Copyright (C) 2006-2015 John MacFarlane <jgm@berkeley.edu>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@@ -20,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
{- |
Module : Text.Pandoc.Writers.HTML
- Copyright : Copyright (C) 2006-2014 John MacFarlane
+ Copyright : Copyright (C) 2006-2015 John MacFarlane
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <jgm@berkeley.edu>
@@ -46,10 +46,13 @@ import Numeric ( showHex )
import Data.Char ( ord, toLower )
import Data.List ( isPrefixOf, intersperse )
import Data.String ( fromString )
-import Data.Maybe ( catMaybes, fromMaybe )
+import Data.Maybe ( catMaybes, fromMaybe, isJust )
import Control.Monad.State
import Text.Blaze.Html hiding(contents)
+#if MIN_VERSION_blaze_markup(0,6,3)
+#else
import Text.Blaze.Internal(preEscapedString)
+#endif
#if MIN_VERSION_blaze_html(0,5,1)
import qualified Text.Blaze.XHtml5 as H5
#else
@@ -60,7 +63,7 @@ import qualified Text.Blaze.XHtml1.Transitional.Attributes as A
import Text.Blaze.Renderer.String (renderHtml)
import Text.TeXMath
import Text.XML.Light.Output
-import Text.XML.Light (unode, elChildren, add_attr, unqual)
+import Text.XML.Light (unode, elChildren, unqual)
import qualified Text.XML.Light as XML
import System.FilePath (takeExtension)
import Data.Monoid
@@ -73,11 +76,13 @@ data WriterState = WriterState
, stQuotes :: Bool -- ^ <q> tag is used
, stHighlighting :: Bool -- ^ Syntax highlighting is used
, stSecNum :: [Int] -- ^ Number of current section
+ , stElement :: Bool -- ^ Processing an Element
}
defaultWriterState :: WriterState
defaultWriterState = WriterState {stNotes= [], stMath = False, stQuotes = False,
- stHighlighting = False, stSecNum = []}
+ stHighlighting = False, stSecNum = [],
+ stElement = False}
-- Helpers to render HTML with the appropriate function.
@@ -189,6 +194,9 @@ pandocToHtml opts (Pandoc meta blocks) = do
defField "revealjs-url" ("reveal.js" :: String) $
defField "s5-url" ("s5/default" :: String) $
defField "html5" (writerHtml5 opts) $
+ defField "center" (case lookupMeta "center" meta of
+ Just (MetaBool False) -> False
+ _ -> True) $
metadata
return (thebody, context)
@@ -280,7 +288,13 @@ elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elemen
let titleSlide = slide && level < slideLevel
header' <- if title' == [Str "\0"] -- marker for hrule
then return mempty
- else blockToHtml opts (Header level' (id',classes,keyvals) title')
+ else do
+ modify (\st -> st{ stElement = True})
+ res <- blockToHtml opts
+ (Header level' (id',classes,keyvals) title')
+ modify (\st -> st{ stElement = False})
+ return res
+
let isSec (Sec _ _ _ _ _) = True
isSec (Blk _) = False
let isPause (Blk x) = x == Para [Str ".",Space,Str ".",Space,Str "."]
@@ -361,8 +375,8 @@ obfuscateLink opts (renderHtml -> txt) s =
(linkText, altText) =
if txt == drop 7 s' -- autolink
then ("e", name' ++ " at " ++ domain')
- else ("'" ++ txt ++ "'", txt ++ " (" ++ name' ++ " at " ++
- domain' ++ ")")
+ else ("'" ++ obfuscateString txt ++ "'",
+ txt ++ " (" ++ name' ++ " at " ++ domain' ++ ")")
in case meth of
ReferenceObfuscation ->
-- need to use preEscapedString or &'s are escaped to &amp; in URL
@@ -430,24 +444,32 @@ blockToHtml opts (Para [Image txt (s,'f':'i':'g':':':tit)]) = do
then H5.figure $ mconcat
[nl opts, img, capt, nl opts]
else H.div ! A.class_ "figure" $ mconcat
- [nl opts, img, capt, nl opts]
+ [nl opts, img, nl opts, capt, nl opts]
blockToHtml opts (Para lst) = do
contents <- inlineListToHtml opts lst
return $ H.p contents
blockToHtml opts (Div attr@(_,classes,_) bs) = do
- contents <- blockListToHtml opts bs
+ let speakerNotes = "notes" `elem` classes
+ -- we don't want incremental output inside speaker notes, see #1394
+ let opts' = if speakerNotes then opts{ writerIncremental = False } else opts
+ contents <- blockListToHtml opts' bs
let contents' = nl opts >> contents >> nl opts
return $
- if "notes" `elem` classes
- then let opts' = opts{ writerIncremental = False } in
- -- we don't want incremental output inside speaker notes
- case writerSlideVariant opts of
+ if speakerNotes
+ then case writerSlideVariant opts of
RevealJsSlides -> addAttrs opts' attr $ H5.aside $ contents'
+ DZSlides -> (addAttrs opts' attr $ H5.div $ contents')
+ ! (H5.customAttribute "role" "note")
NoSlides -> addAttrs opts' attr $ H.div $ contents'
_ -> mempty
else addAttrs opts attr $ H.div $ contents'
-blockToHtml _ (RawBlock f str)
+blockToHtml opts (RawBlock f str)
| f == Format "html" = return $ preEscapedString str
+ | f == Format "latex" =
+ case writerHTMLMathMethod opts of
+ MathJax _ -> do modify (\st -> st{ stMath = True })
+ return $ toHtml str
+ _ -> return mempty
| otherwise = return mempty
blockToHtml opts (HorizontalRule) = return $ if writerHtml5 opts then H5.hr else H.hr
blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
@@ -491,7 +513,7 @@ blockToHtml opts (BlockQuote blocks) =
else do
contents <- blockListToHtml opts blocks
return $ H.blockquote $ nl opts >> contents >> nl opts
-blockToHtml opts (Header level (_,classes,_) lst) = do
+blockToHtml opts (Header level attr@(_,classes,_) lst) = do
contents <- inlineListToHtml opts lst
secnum <- liftM stSecNum get
let contents' = if writerNumberSections opts && not (null secnum)
@@ -499,7 +521,9 @@ blockToHtml opts (Header level (_,classes,_) lst) = do
then (H.span ! A.class_ "header-section-number" $ toHtml
$ showSecNum secnum) >> strToHtml " " >> contents
else contents
- return $ case level of
+ inElement <- gets stElement
+ return $ (if inElement then id else addAttrs opts attr)
+ $ case level of
1 -> H.h1 contents'
2 -> H.h2 contents'
3 -> H.h3 contents'
@@ -512,7 +536,9 @@ blockToHtml opts (BulletList lst) = do
return $ unordList opts contents
blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
contents <- mapM (blockListToHtml opts) lst
- let numstyle' = camelCaseToHyphenated $ show numstyle
+ let numstyle' = case numstyle of
+ Example -> "decimal"
+ _ -> camelCaseToHyphenated $ show numstyle
let attribs = (if startnum /= 1
then [A.start $ toValue startnum]
else []) ++
@@ -629,7 +655,9 @@ annotateMML e tex = math (unode "semantics" [cs, unode "annotation" (annotAttrs,
[] -> unode "mrow" ()
[x] -> x
xs -> unode "mrow" xs
- math = add_attr (XML.Attr (unqual "xmlns") "http://www.w3.org/1998/Math/MathML") . unode "math"
+ math childs = XML.Element q as [XML.Elem childs] l
+ where
+ (XML.Element q as _ l) = e
annotAttrs = [XML.Attr (unqual "encoding") "application/x-tex"]
@@ -639,7 +667,8 @@ inlineToHtml opts inline =
case inline of
(Str str) -> return $ strToHtml str
(Space) -> return $ strToHtml " "
- (LineBreak) -> return $ if writerHtml5 opts then H5.br else H.br
+ (LineBreak) -> return $ (if writerHtml5 opts then H5.br else H.br)
+ <> strToHtml "\n"
(Span (id',classes,kvs) ils)
-> inlineListToHtml opts ils >>=
return . addAttrs opts attr' . H.span
@@ -687,67 +716,72 @@ inlineToHtml opts inline =
H.q `fmap` inlineListToHtml opts lst
else (\x -> leftQuote >> x >> rightQuote)
`fmap` inlineListToHtml opts lst
- (Math t str) -> modify (\st -> st {stMath = True}) >>
- (case writerHTMLMathMethod opts of
- LaTeXMathML _ ->
- -- putting LaTeXMathML in container with class "LaTeX" prevents
- -- non-math elements on the page from being treated as math by
- -- the javascript
- return $ H.span ! A.class_ "LaTeX" $
- case t of
- InlineMath -> toHtml ("$" ++ str ++ "$")
- DisplayMath -> toHtml ("$$" ++ str ++ "$$")
- JsMath _ -> do
- let m = preEscapedString str
- return $ case t of
- InlineMath -> H.span ! A.class_ "math" $ m
- DisplayMath -> H.div ! A.class_ "math" $ m
- WebTeX url -> do
- let imtag = if writerHtml5 opts then H5.img else H.img
- let m = imtag ! A.style "vertical-align:middle"
- ! A.src (toValue $ url ++ urlEncode str)
- ! A.alt (toValue str)
- ! A.title (toValue str)
- let brtag = if writerHtml5 opts then H5.br else H.br
- return $ case t of
- InlineMath -> m
- DisplayMath -> brtag >> m >> brtag
- GladTeX ->
- return $ case t of
- InlineMath -> preEscapedString $ "<EQ ENV=\"math\">" ++ str ++ "</EQ>"
- DisplayMath -> preEscapedString $ "<EQ ENV=\"displaymath\">" ++ str ++ "</EQ>"
- MathML _ -> do
- let dt = if t == InlineMath
- then DisplayInline
- else DisplayBlock
- let conf = useShortEmptyTags (const False)
- defaultConfigPP
- case writeMathML dt <$> readTeX str of
- Right r -> return $ preEscapedString $
- ppcElement conf (annotateMML r str)
- Left _ -> inlineListToHtml opts
- (texMathToInlines t str) >>=
- return . (H.span ! A.class_ "math")
- MathJax _ -> return $ H.span ! A.class_ "math" $ toHtml $
- case t of
- InlineMath -> "\\(" ++ str ++ "\\)"
- DisplayMath -> "\\[" ++ str ++ "\\]"
- KaTeX _ _ -> return $ H.span ! A.class_ "math" $
- toHtml (case t of
- InlineMath -> str
- DisplayMath -> "\\displaystyle " ++ str)
- PlainMath -> do
- x <- inlineListToHtml opts (texMathToInlines t str)
- let m = H.span ! A.class_ "math" $ x
- let brtag = if writerHtml5 opts then H5.br else H.br
- return $ case t of
- InlineMath -> m
- DisplayMath -> brtag >> m >> brtag )
+ (Math t str) -> do
+ modify (\st -> st {stMath = True})
+ let mathClass = toValue $ ("math " :: String) ++
+ if t == InlineMath then "inline" else "display"
+ case writerHTMLMathMethod opts of
+ LaTeXMathML _ ->
+ -- putting LaTeXMathML in container with class "LaTeX" prevents
+ -- non-math elements on the page from being treated as math by
+ -- the javascript
+ return $ H.span ! A.class_ "LaTeX" $
+ case t of
+ InlineMath -> toHtml ("$" ++ str ++ "$")
+ DisplayMath -> toHtml ("$$" ++ str ++ "$$")
+ JsMath _ -> do
+ let m = preEscapedString str
+ return $ case t of
+ InlineMath -> H.span ! A.class_ mathClass $ m
+ DisplayMath -> H.div ! A.class_ mathClass $ m
+ WebTeX url -> do
+ let imtag = if writerHtml5 opts then H5.img else H.img
+ let m = imtag ! A.style "vertical-align:middle"
+ ! A.src (toValue $ url ++ urlEncode str)
+ ! A.alt (toValue str)
+ ! A.title (toValue str)
+ let brtag = if writerHtml5 opts then H5.br else H.br
+ return $ case t of
+ InlineMath -> m
+ DisplayMath -> brtag >> m >> brtag
+ GladTeX ->
+ return $ case t of
+ InlineMath -> preEscapedString $ "<EQ ENV=\"math\">" ++ str ++ "</EQ>"
+ DisplayMath -> preEscapedString $ "<EQ ENV=\"displaymath\">" ++ str ++ "</EQ>"
+ MathML _ -> do
+ let dt = if t == InlineMath
+ then DisplayInline
+ else DisplayBlock
+ let conf = useShortEmptyTags (const False)
+ defaultConfigPP
+ case writeMathML dt <$> readTeX str of
+ Right r -> return $ preEscapedString $
+ ppcElement conf (annotateMML r str)
+ Left _ -> inlineListToHtml opts
+ (texMathToInlines t str) >>=
+ return . (H.span ! A.class_ mathClass)
+ MathJax _ -> return $ H.span ! A.class_ mathClass $ toHtml $
+ case t of
+ InlineMath -> "\\(" ++ str ++ "\\)"
+ DisplayMath -> "\\[" ++ str ++ "\\]"
+ KaTeX _ _ -> return $ H.span ! A.class_ mathClass $
+ toHtml (case t of
+ InlineMath -> str
+ DisplayMath -> "\\displaystyle " ++ str)
+ PlainMath -> do
+ x <- inlineListToHtml opts (texMathToInlines t str)
+ let m = H.span ! A.class_ mathClass $ x
+ let brtag = if writerHtml5 opts then H5.br else H.br
+ return $ case t of
+ InlineMath -> m
+ DisplayMath -> brtag >> m >> brtag
(RawInline f str)
| f == Format "latex" ->
case writerHTMLMathMethod opts of
LaTeXMathML _ -> do modify (\st -> st {stMath = True})
return $ toHtml str
+ MathJax _ -> do modify (\st -> st {stMath = True})
+ return $ toHtml str
_ -> return mempty
| f == Format "html" -> return $ preEscapedString str
| otherwise -> return mempty
@@ -768,22 +802,15 @@ inlineToHtml opts inline =
then link'
else link' ! A.title (toValue tit)
(Image txt (s,tit)) | treatAsImage s -> do
- let alternate' = stringify txt
let attributes = [A.src $ toValue s] ++
- (if null tit
- then []
- else [A.title $ toValue tit]) ++
- if null txt
- then []
- else [A.alt $ toValue alternate']
+ [A.title $ toValue tit | not $ null tit] ++
+ [A.alt $ toValue $ stringify txt]
let tag = if writerHtml5 opts then H5.img else H.img
return $ foldl (!) tag attributes
-- note: null title included, as in Markdown.pl
(Image _ (s,tit)) -> do
let attributes = [A.src $ toValue s] ++
- (if null tit
- then []
- else [A.title $ toValue tit])
+ [A.title $ toValue tit | not $ null tit]
return $ foldl (!) H5.embed attributes
-- note: null title included, as in Markdown.pl
(Note contents)
@@ -803,7 +830,9 @@ inlineToHtml opts inline =
writerIdentifierPrefix opts ++ "fn" ++ ref)
! A.class_ "footnoteRef"
! prefixedId opts ("fnref" ++ ref)
- $ H.sup
+ $ (if isJust (writerEpubVersion opts)
+ then id
+ else H.sup)
$ toHtml ref
return $ case writerEpubVersion opts of
Just EPUB3 -> link ! customAttribute "epub:type" "noteref"