Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Use blaze-html instead of xhtml for HTML generation.

Browse source 
* This is a breaking API change for `writeHtml`.
* It introduces a new dependency on blaze-html.
* Pandoc now depends on highlighting-kate >= 0.4, which
  also uses blaze-html.
* The --ascii option has been removed, because of differences
  in blaze-html's and xhtml's escaping.
* Pandoc will no longer transform leading newlines in code
  blocks to `<br/>` tags.
This commit is contained in:
John MacFarlane 2011-12-15 21:17:32 -08:00
parent d78e9c1dac
commit 89c962a18c
6 changed files with 226 additions and 231 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
README
View file

@ -303,11 +303,6 @@ Options
`--columns`=*NUMBER* `--columns`=*NUMBER*
: Specify length of lines in characters (for text wrapping). : Specify length of lines in characters (for text wrapping).
`--ascii`
: Use only ascii characters in output. Currently supported only
for HTML output (which uses numerical entities instead of
UTF-8 when this option is selected).
`--email-obfuscation=`*none|javascript|references* `--email-obfuscation=`*none|javascript|references*
: Specify a method for obfuscating `mailto:` links in HTML documents. : Specify a method for obfuscating `mailto:` links in HTML documents.
*none* leaves `mailto:` links as they are. *javascript* obfuscates *none* leaves `mailto:` links as they are. *javascript* obfuscates

8
pandoc.cabal
View file

@ -202,7 +202,7 @@ Library
-- BEGIN DUPLICATED SECTION -- BEGIN DUPLICATED SECTION
Build-Depends: containers >= 0.1 && < 0.5, Build-Depends: containers >= 0.1 && < 0.5,
parsec >= 2.1 && < 3.2, parsec >= 2.1 && < 3.2,
xhtml >= 3000.0 && < 3000.3, blaze-html >= 0.4 && < 0.5,
mtl >= 1.1 && < 2.1, mtl >= 1.1 && < 2.1,
network >= 2 && < 2.4, network >= 2 && < 2.4,
filepath >= 1.1 && < 1.3, filepath >= 1.1 && < 1.3,
@ -229,7 +229,7 @@ Library
else else
Build-depends: base >= 3 && < 4 Build-depends: base >= 3 && < 4
if flag(highlighting) if flag(highlighting)
Build-depends: highlighting-kate >= 0.2.9 && < 0.4 Build-depends: highlighting-kate >= 0.4 && < 0.5
cpp-options: -D_HIGHLIGHTING cpp-options: -D_HIGHLIGHTING
if impl(ghc >= 6.12) if impl(ghc >= 6.12)
Ghc-Options: -O2 -Wall -fno-warn-unused-do-bind Ghc-Options: -O2 -Wall -fno-warn-unused-do-bind
@ -290,7 +290,7 @@ Executable pandoc
-- BEGIN DUPLICATED SECTION -- BEGIN DUPLICATED SECTION
Build-Depends: containers >= 0.1 && < 0.5, Build-Depends: containers >= 0.1 && < 0.5,
parsec >= 2.1 && < 3.2, parsec >= 2.1 && < 3.2,
xhtml >= 3000.0 && < 3000.3, blaze-html >= 0.4 && < 0.5,
mtl >= 1.1 && < 2.1, mtl >= 1.1 && < 2.1,
network >= 2 && < 2.4, network >= 2 && < 2.4,
filepath >= 1.1 && < 1.3, filepath >= 1.1 && < 1.3,
@ -317,7 +317,7 @@ Executable pandoc
else else
Build-depends: base >= 3 && < 4 Build-depends: base >= 3 && < 4
if flag(highlighting) if flag(highlighting)
Build-depends: highlighting-kate >= 0.2.9 && < 0.4 Build-depends: highlighting-kate >= 0.4 && < 0.5
cpp-options: -D_HIGHLIGHTING cpp-options: -D_HIGHLIGHTING
if impl(ghc >= 6.12) if impl(ghc >= 6.12)
Ghc-Options: -O2 -Wall -fno-warn-unused-do-bind Ghc-Options: -O2 -Wall -fno-warn-unused-do-bind

8
src/Text/Pandoc/Highlighting.hs
View file

@ -29,10 +29,10 @@ Exports functions for syntax highlighting.
-} -}
module Text.Pandoc.Highlighting ( languages, highlightHtml, defaultHighlightingCss, languagesByExtension ) where module Text.Pandoc.Highlighting ( languages, highlightHtml, defaultHighlightingCss, languagesByExtension ) where
import Text.XHtml import Text.Blaze
import Text.Pandoc.Definition import Text.Pandoc.Definition
#ifdef _HIGHLIGHTING #ifdef _HIGHLIGHTING
import Text.Highlighting.Kate ( languages, highlightAs, formatAsXHtml, FormatOption (..), defaultHighlightingCss, languagesByExtension ) import Text.Highlighting.Kate ( languages, highlightAs, formatAsHtml, FormatOption (..), defaultHighlightingCss, languagesByExtension )
import Data.List (find) import Data.List (find)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Char (toLower) import Data.Char (toLower)
@ -54,9 +54,9 @@ highlightHtml inline (_, classes, keyvals) rawCode =
Nothing -> Left "Unknown or unsupported language" Nothing -> Left "Unknown or unsupported language"
Just language -> case highlightAs language rawCode of Just language -> case highlightAs language rawCode of
Left err -> Left err Left err -> Left err
Right hl -> Right $ formatAsXHtml fmtOpts language $ Right hl -> Right $ formatAsHtml fmtOpts language $
if addBirdTracks if addBirdTracks
then map ((["Special"],"> "):) hl then map (("ot","> "):) hl
else hl else hl
#else #else

4
src/Text/Pandoc/Templates.hs
View file

@ -72,7 +72,7 @@ import Text.ParserCombinators.Parsec
import Control.Monad (liftM, when, forM) import Control.Monad (liftM, when, forM)
import System.FilePath import System.FilePath
import Data.List (intercalate, intersperse) import Data.List (intercalate, intersperse)
import Text.XHtml (primHtml, Html) import Text.Blaze (preEscapedString, Html)
import Data.ByteString.Lazy.UTF8 (ByteString, fromString) import Data.ByteString.Lazy.UTF8 (ByteString, fromString)
import Text.Pandoc.Shared (readDataFile) import Text.Pandoc.Shared (readDataFile)
import qualified Control.Exception.Extensible as E (try, IOException) import qualified Control.Exception.Extensible as E (try, IOException)
@ -111,7 +111,7 @@ instance TemplateTarget ByteString where
toTarget = fromString toTarget = fromString
instance TemplateTarget Html where instance TemplateTarget Html where
toTarget = primHtml toTarget = preEscapedString
-- | Renders a template -- | Renders a template
renderTemplate :: TemplateTarget a renderTemplate :: TemplateTarget a

411
src/Text/Pandoc/Writers/HTML.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-} {-# OPTIONS_GHC -fno-warn-deprecations #-}
{- {-
Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu> Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
@ -35,43 +36,44 @@ import Text.Pandoc.Shared
import Text.Pandoc.Templates import Text.Pandoc.Templates
import Text.Pandoc.Readers.TeXMath import Text.Pandoc.Readers.TeXMath
import Text.Pandoc.Highlighting ( highlightHtml, defaultHighlightingCss ) import Text.Pandoc.Highlighting ( highlightHtml, defaultHighlightingCss )
import Text.Pandoc.XML (stripTags, escapeStringForXML) import Text.Pandoc.XML (stripTags)
import Network.HTTP ( urlEncode ) import Network.HTTP ( urlEncode )
import Numeric ( showHex ) import Numeric ( showHex )
import Data.Char ( ord, toLower ) import Data.Char ( ord, toLower )
import Data.List ( isPrefixOf, intersperse ) import Data.List ( isPrefixOf, intersperse )
import Data.String ( fromString )
import Data.Maybe ( catMaybes ) import Data.Maybe ( catMaybes )
import Control.Monad.State import Control.Monad.State
import Text.XHtml.Transitional hiding ( stringToHtml, unordList, ordList ) import Text.Blaze
import qualified Text.XHtml.Transitional as XHtml import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import qualified Text.Blaze.Html4.Transitional.Attributes as A4
import Text.Blaze.Renderer.String (renderHtml)
import Text.TeXMath import Text.TeXMath
import Text.XML.Light.Output import Text.XML.Light.Output
import System.FilePath (takeExtension) import System.FilePath (takeExtension)
import Data.Monoid (mempty, mconcat)
data WriterState = WriterState data WriterState = WriterState
{ stNotes :: [Html] -- ^ List of notes { stNotes :: [Html] -- ^ List of notes
, stMath :: Bool -- ^ Math is used in document , stMath :: Bool -- ^ Math is used in document
, stHighlighting :: Bool -- ^ Syntax highlighting is used , stHighlighting :: Bool -- ^ Syntax highlighting is used
, stSecNum :: [Int] -- ^ Number of current section , stSecNum :: [Int] -- ^ Number of current section
} deriving Show }
defaultWriterState :: WriterState defaultWriterState :: WriterState
defaultWriterState = WriterState {stNotes= [], stMath = False, stHighlighting = False, stSecNum = []} defaultWriterState = WriterState {stNotes= [], stMath = False, stHighlighting = False, stSecNum = []}
-- Helpers to render HTML with the appropriate function. -- Helpers to render HTML with the appropriate function.
-- | Modified version of Text.XHtml's stringToHtml. strToHtml :: String -> Html
-- Use unicode characters wherever possible. strToHtml = toHtml
stringToHtml :: WriterOptions -> String -> Html
stringToHtml opts = if writerAscii opts
then XHtml.stringToHtml
else primHtml . escapeStringForXML
-- | Hard linebreak. -- | Hard linebreak.
nl :: WriterOptions -> Html nl :: WriterOptions -> Html
nl opts = if writerWrapText opts nl opts = if writerWrapText opts
then primHtml "\n" then preEscapedString "\n"
else noHtml else mempty
-- | Convert Pandoc document to Html string. -- | Convert Pandoc document to Html string.
writeHtmlString :: WriterOptions -> Pandoc -> String writeHtmlString :: WriterOptions -> Pandoc -> String
@ -80,7 +82,7 @@ writeHtmlString opts d =
defaultWriterState defaultWriterState
in if writerStandalone opts in if writerStandalone opts
then inTemplate opts tit auths date toc body' newvars then inTemplate opts tit auths date toc body' newvars
else dropWhile (=='\n') $ showHtmlFragment body' else renderHtml body'
-- | Convert Pandoc document to Html structure. -- | Convert Pandoc document to Html structure.
writeHtml :: WriterOptions -> Pandoc -> Html writeHtml :: WriterOptions -> Pandoc -> Html
@ -99,13 +101,13 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
let standalone = writerStandalone opts let standalone = writerStandalone opts
tit <- if standalone tit <- if standalone
then inlineListToHtml opts title' then inlineListToHtml opts title'
else return noHtml else return mempty
auths <- if standalone auths <- if standalone
then mapM (inlineListToHtml opts) authors' then mapM (inlineListToHtml opts) authors'
else return [] else return []
date <- if standalone date <- if standalone
then inlineListToHtml opts date' then inlineListToHtml opts date'
else return noHtml else return mempty
let splitHrule (HorizontalRule : Header 1 xs : ys) let splitHrule (HorizontalRule : Header 1 xs : ys)
= Header 1 xs : splitHrule ys = Header 1 xs : splitHrule ys
splitHrule (HorizontalRule : xs) = Header 1 [] : splitHrule xs splitHrule (HorizontalRule : xs) = Header 1 [] : splitHrule xs
@ -120,34 +122,39 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
toc <- if writerTableOfContents opts toc <- if writerTableOfContents opts
then tableOfContents opts sects then tableOfContents opts sects
else return Nothing else return Nothing
blocks' <- liftM (toHtmlFromList . intersperse (nl opts)) $ blocks' <- liftM (mconcat . intersperse (nl opts)) $
mapM (elementToHtml opts) sects mapM (elementToHtml opts) sects
st <- get st <- get
let notes = reverse (stNotes st) let notes = reverse (stNotes st)
let thebody = blocks' +++ footnoteSection opts notes let thebody = blocks' >> footnoteSection opts notes
let math = if stMath st let math = if stMath st
then case writerHTMLMathMethod opts of then case writerHTMLMathMethod opts of
LaTeXMathML (Just url) -> LaTeXMathML (Just url) ->
script ! H.script ! A.src (toValue url)
[src url, thetype "text/javascript"] $ noHtml ! A.type_ "text/javascript"
$ mempty
MathML (Just url) -> MathML (Just url) ->
script ! H.script ! A.src (toValue url)
[src url, thetype "text/javascript"] $ noHtml ! A.type_ "text/javascript"
$ mempty
MathJax url -> MathJax url ->
script ! [src url, thetype "text/javascript"] $ noHtml H.script ! A.src (toValue url)
! A.type_ "text/javascript"
$ mempty
JsMath (Just url) -> JsMath (Just url) ->
script ! H.script ! A.src (toValue url)
[src url, thetype "text/javascript"] $ noHtml ! A.type_ "text/javascript"
$ mempty
_ -> case lookup "mathml-script" (writerVariables opts) of _ -> case lookup "mathml-script" (writerVariables opts) of
Just s -> Just s ->
script ! [thetype "text/javascript"] << H.script ! A.type_ "text/javascript"
primHtml ("/*<![CDATA[*/\n" ++ s ++ $ preEscapedString
"/*]]>*/\n") ("/*<![CDATA[*/\n" ++ s ++ "/*]]>*/\n")
Nothing -> noHtml Nothing -> mempty
else noHtml else mempty
let newvars = [("highlighting-css", defaultHighlightingCss) | let newvars = [("highlighting-css", defaultHighlightingCss) |
stHighlighting st] ++ stHighlighting st] ++
[("math", showHtmlFragment math) | stMath st] [("math", renderHtml math) | stMath st]
return (tit, auths, date, toc, thebody, newvars) return (tit, auths, date, toc, thebody, newvars)
inTemplate :: TemplateTarget a inTemplate :: TemplateTarget a
@ -160,12 +167,12 @@ inTemplate :: TemplateTarget a
-> [(String,String)] -> [(String,String)]
-> a -> a
inTemplate opts tit auths date toc body' newvars = inTemplate opts tit auths date toc body' newvars =
let title' = dropWhile (=='\n') $ showHtmlFragment tit let title' = renderHtml tit
authors = map showHtmlFragment auths authors = map renderHtml auths
date' = showHtmlFragment date date' = renderHtml date
variables = writerVariables opts ++ newvars variables = writerVariables opts ++ newvars
context = variables ++ context = variables ++
[ ("body", dropWhile (=='\n') $ showHtmlFragment body') [ ("body", dropWhile (=='\n') $ renderHtml body')
, ("pagetitle", stripTags title') , ("pagetitle", stripTags title')
, ("title", title') , ("title", title')
, ("date", date') , ("date", date')
@ -175,23 +182,23 @@ inTemplate opts tit auths date toc body' newvars =
, ("s5-url", "s5/default") ] ++ , ("s5-url", "s5/default") ] ++
[ ("html5","true") | writerHtml5 opts ] ++ [ ("html5","true") | writerHtml5 opts ] ++
(case toc of (case toc of
Just t -> [ ("toc", showHtmlFragment t)] Just t -> [ ("toc", renderHtml t)]
Nothing -> []) ++ Nothing -> []) ++
[ ("author", a) | a <- authors ] ++ [ ("author", a) | a <- authors ] ++
[ ("author-meta", stripTags a) | a <- authors ] [ ("author-meta", stripTags a) | a <- authors ]
in renderTemplate context $ writerTemplate opts in renderTemplate context $ writerTemplate opts
-- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix -- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix
prefixedId :: WriterOptions -> String -> HtmlAttr prefixedId :: WriterOptions -> String -> Attribute
prefixedId opts s = identifier $ writerIdentifierPrefix opts ++ s prefixedId opts s = A.id $ toValue $ writerIdentifierPrefix opts ++ s
-- | Replacement for Text.XHtml's unordList. -- | Replacement for Text.XHtml's unordList.
unordList :: WriterOptions -> ([Html] -> Html) unordList :: WriterOptions -> ([Html] -> Html)
unordList opts items = ulist << toListItems opts items unordList opts items = H.ul $ mconcat $ toListItems opts items
-- | Replacement for Text.XHtml's ordList. -- | Replacement for Text.XHtml's ordList.
ordList :: WriterOptions -> ([Html] -> Html) ordList :: WriterOptions -> ([Html] -> Html)
ordList opts items = olist << toListItems opts items ordList opts items = H.ol $ mconcat $ toListItems opts items
-- | 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)
@ -214,15 +221,16 @@ elementToListItem :: WriterOptions -> Element -> State WriterState (Maybe Html)
elementToListItem _ (Blk _) = return Nothing elementToListItem _ (Blk _) = return Nothing
elementToListItem opts (Sec _ num id' headerText subsecs) = do elementToListItem opts (Sec _ num id' headerText subsecs) = do
let sectnum = if writerNumberSections opts let sectnum = if writerNumberSections opts
then (thespan ! [theclass "toc-section-number"] << showSecNum num) +++ then (H.span ! A.class_ "toc-section-number" $ toHtml $ showSecNum num) >>
stringToHtml opts" " preEscapedString " "
else noHtml else mempty
txt <- liftM (sectnum +++) $ inlineListToHtml opts headerText txt <- liftM (sectnum >>) $ inlineListToHtml opts headerText
subHeads <- mapM (elementToListItem opts) subsecs >>= return . catMaybes subHeads <- mapM (elementToListItem opts) subsecs >>= return . catMaybes
let subList = if null subHeads let subList = if null subHeads
then noHtml then mempty
else unordList opts subHeads else unordList opts subHeads
return $ Just $ (anchor ! [href ("#" ++ writerIdentifierPrefix opts ++ id')] $ txt) +++ subList return $ Just $ (H.a ! A.href (toValue $ "#" ++ writerIdentifierPrefix opts ++ id')
$ toHtml txt) >> subList
-- | Convert an Element to Html. -- | Convert an Element to Html.
elementToHtml :: WriterOptions -> Element -> State WriterState Html elementToHtml :: WriterOptions -> Element -> State WriterState Html
@ -231,37 +239,38 @@ elementToHtml opts (Sec level num id' title' elements) = do
modify $ \st -> st{stSecNum = num} -- update section number modify $ \st -> st{stSecNum = num} -- update section number
header' <- blockToHtml opts (Header level title') header' <- blockToHtml opts (Header level title')
innerContents <- mapM (elementToHtml opts) elements innerContents <- mapM (elementToHtml opts) elements
let header'' = header' ! [prefixedId opts id' | let header'' = if (writerStrictMarkdown opts ||
not (writerStrictMarkdown opts ||
writerSectionDivs opts || writerSectionDivs opts ||
writerSlideVariant opts == S5Slides)] writerSlideVariant opts == S5Slides)
then header'
else header' ! prefixedId opts id'
let stuff = header'' : innerContents let stuff = header'' : innerContents
let slide = writerSlideVariant opts /= NoSlides && level == 1 let slide = writerSlideVariant opts /= NoSlides && level == 1
let titleSlide = slide && null elements let titleSlide = slide && null elements
let attrs = [prefixedId opts id' | writerSectionDivs opts] ++ let attrs = [prefixedId opts id' | writerSectionDivs opts] ++
[theclass "titleslide" | titleSlide] ++ [A.class_ "titleslide" | titleSlide] ++
[theclass "slide" | slide] [A.class_ "slide" | slide]
let inNl x = nl opts : intersperse (nl opts) x ++ [nl opts] let inNl x = mconcat $ nl opts : intersperse (nl opts) x ++ [nl opts]
return $ if writerSectionDivs opts || slide return $ if writerSectionDivs opts || slide
then if writerHtml5 opts then if writerHtml5 opts
then tag "section" ! attrs << inNl stuff then foldl (!) (H.section $ inNl stuff) attrs
else thediv ! attrs << inNl stuff else foldl (!) (H.div $ inNl stuff) attrs
else toHtmlFromList $ intersperse (nl opts) stuff else mconcat $ intersperse (nl opts) stuff
-- | Convert list of Note blocks to a footnote <div>. -- | Convert list of Note blocks to a footnote <div>.
-- Assumes notes are sorted. -- Assumes notes are sorted.
footnoteSection :: WriterOptions -> [Html] -> Html footnoteSection :: WriterOptions -> [Html] -> Html
footnoteSection opts notes = footnoteSection opts notes =
if null notes if null notes
then noHtml then mempty
else nl opts +++ (container else nl opts >> (container
$ nl opts +++ hr +++ nl opts +++ $ nl opts >> H.hr >> nl opts >>
(olist << (notes ++ [nl opts])) +++ nl opts) H.ol (mconcat notes >> nl opts))
where container = if writerHtml5 opts where container x = if writerHtml5 opts
then tag "section" ! [theclass "footnotes"] then H.section ! A.class_ "footnotes" $ x
else if writerSlideVariant opts /= NoSlides else if writerSlideVariant opts /= NoSlides
then thediv ! [theclass "footnotes slide"] then H.div ! A.class_ "footnotes slide" $ x
else thediv ! [theclass "footnotes"] else H.div ! A.class_ "footnotes" $ x
-- | Parse a mailto link; return Just (name, domain) or Nothing. -- | Parse a mailto link; return Just (name, domain) or Nothing.
parseMailto :: String -> Maybe (String, String) parseMailto :: String -> Maybe (String, String)
@ -274,7 +283,7 @@ parseMailto _ = Nothing
-- | Obfuscate a "mailto:" link. -- | Obfuscate a "mailto:" link.
obfuscateLink :: WriterOptions -> String -> String -> Html obfuscateLink :: WriterOptions -> String -> String -> Html
obfuscateLink opts txt s | writerEmailObfuscation opts == NoObfuscation = obfuscateLink opts txt s | writerEmailObfuscation opts == NoObfuscation =
anchor ! [href s] << txt H.a ! A.href (toValue s) $ toHtml txt
obfuscateLink opts txt s = obfuscateLink opts txt s =
let meth = writerEmailObfuscation opts let meth = writerEmailObfuscation opts
s' = map toLower s s' = map toLower s
@ -289,19 +298,19 @@ obfuscateLink opts txt s =
domain' ++ ")") domain' ++ ")")
in case meth of in case meth of
ReferenceObfuscation -> ReferenceObfuscation ->
-- need to use primHtml or &'s are escaped to &amp; in URL -- need to use preEscapedString or &'s are escaped to &amp; in URL
primHtml $ "<a href=\"" ++ (obfuscateString s') preEscapedString $ "<a href=\"" ++ (obfuscateString s')
++ "\">" ++ (obfuscateString txt) ++ "</a>" ++ "\">" ++ (obfuscateString txt) ++ "</a>"
JavascriptObfuscation -> JavascriptObfuscation ->
(script ! [thetype "text/javascript"] $ (H.script ! A.type_ "text/javascript" $
primHtml ("\n<!--\nh='" ++ preEscapedString ("\n<!--\nh='" ++
obfuscateString domain ++ "';a='" ++ at' ++ "';n='" ++ obfuscateString domain ++ "';a='" ++ at' ++ "';n='" ++
obfuscateString name' ++ "';e=n+a+h;\n" ++ obfuscateString name' ++ "';e=n+a+h;\n" ++
"document.write('<a h'+'ref'+'=\"ma'+'ilto'+':'+e+'\">'+" ++ "document.write('<a h'+'ref'+'=\"ma'+'ilto'+':'+e+'\">'+" ++
linkText ++ "+'<\\/'+'a'+'>');\n// -->\n")) +++ linkText ++ "+'<\\/'+'a'+'>');\n// -->\n")) >>
noscript (primHtml $ obfuscateString altText) H.noscript (preEscapedString $ obfuscateString altText)
_ -> error $ "Unknown obfuscation method: " ++ show meth _ -> error $ "Unknown obfuscation method: " ++ show meth
_ -> anchor ! [href s] $ stringToHtml opts txt -- malformed email _ -> H.a ! A.href (toValue s) $ toHtml txt -- malformed email
-- | Obfuscate character as entity. -- | Obfuscate character as entity.
obfuscateChar :: Char -> String obfuscateChar :: Char -> String
@ -314,11 +323,11 @@ obfuscateChar char =
obfuscateString :: String -> String obfuscateString :: String -> String
obfuscateString = concatMap obfuscateChar . decodeCharacterReferences obfuscateString = concatMap obfuscateChar . decodeCharacterReferences
attrsToHtml :: WriterOptions -> Attr -> [HtmlAttr] attrsToHtml :: WriterOptions -> Attr -> [Attribute]
attrsToHtml opts (id',classes',keyvals) = attrsToHtml opts (id',classes',keyvals) =
[theclass (unwords classes') | not (null classes')] ++ [A.class_ (toValue $ unwords classes') | not (null classes')] ++
[prefixedId opts id' | not (null id')] ++ [prefixedId opts id' | not (null id')] ++
map (\(x,y) -> strAttr x y) keyvals map (\(x,y) -> customAttribute (fromString x) (toValue y)) keyvals
imageExts :: [String] imageExts :: [String]
imageExts = [ "art", "bmp", "cdr", "cdt", "cpt", "cr2", "crw", "djvu", "erf", imageExts = [ "art", "bmp", "cdr", "cdt", "cpt", "cr2", "crw", "djvu", "erf",
@ -333,38 +342,34 @@ treatAsImage fp =
-- | Convert Pandoc block element to HTML. -- | Convert Pandoc block element to HTML.
blockToHtml :: WriterOptions -> Block -> State WriterState Html blockToHtml :: WriterOptions -> Block -> State WriterState Html
blockToHtml _ Null = return noHtml blockToHtml _ Null = return mempty
blockToHtml opts (Plain lst) = inlineListToHtml opts lst blockToHtml opts (Plain lst) = inlineListToHtml opts lst
blockToHtml opts (Para [Image txt (s,tit)]) = do blockToHtml opts (Para [Image txt (s,tit)]) = do
img <- inlineToHtml opts (Image txt (s,tit)) img <- inlineToHtml opts (Image txt (s,tit))
capt <- inlineListToHtml opts txt capt <- inlineListToHtml opts txt
return $ if writerHtml5 opts return $ if writerHtml5 opts
then tag "figure" << then H.figure $ mconcat
[nl opts, img, tag "figcaption" << capt, nl opts] [nl opts, img, H.figcaption capt, nl opts]
else thediv ! [theclass "figure"] << else H.div ! A.class_ "figure" $ mconcat
[nl opts, img, paragraph ! [theclass "caption"] << capt, [nl opts, img, H.p ! A.class_ "caption" $ capt,
nl opts] nl opts]
blockToHtml opts (Para lst) = do blockToHtml opts (Para lst) = do
contents <- inlineListToHtml opts lst contents <- inlineListToHtml opts lst
return $ paragraph contents return $ H.p contents
blockToHtml _ (RawBlock "html" str) = return $ primHtml str blockToHtml _ (RawBlock "html" str) = return $ preEscapedString str
blockToHtml _ (RawBlock _ _) = return noHtml blockToHtml _ (RawBlock _ _) = return mempty
blockToHtml _ (HorizontalRule) = return hr blockToHtml _ (HorizontalRule) = return H.hr
blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
let classes' = if writerLiterateHaskell opts let classes' = if writerLiterateHaskell opts
then classes then classes
else filter (/= "literate") classes else filter (/= "literate") classes
case highlightHtml False (id',classes',keyvals) rawCode of case highlightHtml False (id',classes',keyvals) rawCode of
Left _ -> -- change leading newlines into <br /> tags, because some Left _ -> let attrs = attrsToHtml opts (id', classes', keyvals)
-- browsers ignore leading newlines in pre blocks
let (leadingBreaks, rawCode') = span (=='\n') rawCode
attrs = attrsToHtml opts (id', classes', keyvals)
addBird = if "literate" `elem` classes' addBird = if "literate" `elem` classes'
then unlines . map ("> " ++) . lines then unlines . map ("> " ++) . lines
else unlines . lines else unlines . lines
in return $ pre ! attrs $ thecode << in return $ foldl (!) H.pre attrs $ H.code
(replicate (length leadingBreaks) br +++ $ toHtml $ addBird rawCode
[stringToHtml opts $ addBird rawCode'])
Right h -> modify (\st -> st{ stHighlighting = True }) >> Right h -> modify (\st -> st{ stHighlighting = True }) >>
return h return h
blockToHtml opts (BlockQuote blocks) = blockToHtml opts (BlockQuote blocks) =
@ -380,47 +385,48 @@ blockToHtml opts (BlockQuote blocks) =
blockToHtml (opts {writerIncremental = inc}) blockToHtml (opts {writerIncremental = inc})
(OrderedList attribs lst) (OrderedList attribs lst)
_ -> do contents <- blockListToHtml opts blocks _ -> do contents <- blockListToHtml opts blocks
return $ blockquote (nl opts +++ return $ H.blockquote
contents +++ nl opts) $ nl opts >> contents >> nl opts
else do else do
contents <- blockListToHtml opts blocks contents <- blockListToHtml opts blocks
return $ blockquote (nl opts +++ contents +++ nl opts) return $ H.blockquote $ nl opts >> contents >> nl opts
blockToHtml opts (Header level lst) = do blockToHtml opts (Header level lst) = do
contents <- inlineListToHtml opts lst contents <- inlineListToHtml opts lst
secnum <- liftM stSecNum get secnum <- liftM stSecNum get
let contents' = if writerNumberSections opts let contents' = if writerNumberSections opts
then (thespan ! [theclass "header-section-number"] << showSecNum secnum) +++ then (H.span ! A.class_ "header-section-number" $ toHtml $ showSecNum secnum) >>
stringToHtml opts " " +++ contents strToHtml " " >> contents
else contents else contents
let contents'' = if writerTableOfContents opts let contents'' = if writerTableOfContents opts
then anchor ! [href $ "#" ++ writerIdentifierPrefix opts ++ "TOC"] $ contents' then H.a ! A.href (toValue $ "#" ++ writerIdentifierPrefix opts ++ "TOC") $ contents'
else contents' else contents'
return $ (case level of return $ (case level of
1 -> h1 contents'' 1 -> H.h1 contents''
2 -> h2 contents'' 2 -> H.h2 contents''
3 -> h3 contents'' 3 -> H.h3 contents''
4 -> h4 contents'' 4 -> H.h4 contents''
5 -> h5 contents'' 5 -> H.h5 contents''
6 -> h6 contents'' 6 -> H.h6 contents''
_ -> paragraph 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 attribs = if writerIncremental opts let lst' = unordList opts contents
then [theclass "incremental"] let lst'' = if writerIncremental opts
else [] then lst' ! A.class_ "incremental"
return $ (unordList opts contents) ! attribs 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 writerIncremental opts
then [theclass "incremental"] then [A.class_ "incremental"]
else []) ++ else []) ++
(if startnum /= 1 (if startnum /= 1
then [start startnum] then [A.start $ toValue startnum]
else []) ++ else []) ++
(if numstyle /= DefaultStyle (if numstyle /= DefaultStyle
then if writerHtml5 opts then if writerHtml5 opts
then [strAttr "type" $ then [A.type_ $
case numstyle of case numstyle of
Decimal -> "1" Decimal -> "1"
LowerAlpha -> "a" LowerAlpha -> "a"
@ -428,44 +434,44 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
LowerRoman -> "i" LowerRoman -> "i"
UpperRoman -> "I" UpperRoman -> "I"
_ -> "1"] _ -> "1"]
else [thestyle $ "list-style-type: " ++ else [A.style $ toValue $ "list-style-type: " ++
numstyle'] numstyle']
else []) else [])
return $ (ordList opts contents) ! attribs return $ foldl (!) (ordList opts contents) attribs
blockToHtml opts (DefinitionList lst) = do blockToHtml opts (DefinitionList lst) = do
contents <- mapM (\(term, defs) -> contents <- mapM (\(term, defs) ->
do term' <- liftM (dterm <<) $ inlineListToHtml opts term do term' <- liftM (H.dt) $ inlineListToHtml opts term
defs' <- mapM ((liftM (\x -> ddef << (x +++ nl opts))) . defs' <- mapM ((liftM (\x -> H.dd $ (x >> nl opts))) .
blockListToHtml opts) defs blockListToHtml opts) defs
return $ nl opts : term' : nl opts : defs') lst return $ mconcat $ nl opts : term' : nl opts : defs') lst
let attribs = if writerIncremental opts let lst' = H.dl $ mconcat contents >> nl opts
then [theclass "incremental"] let lst'' = if writerIncremental opts
else [] then lst' ! A.class_ "incremental"
return $ dlist ! attribs << (concat contents +++ nl opts) else lst'
return lst''
blockToHtml opts (Table capt aligns widths headers rows') = do blockToHtml opts (Table capt aligns widths headers rows') = do
captionDoc <- if null capt captionDoc <- if null capt
then return noHtml then return mempty
else do else do
cs <- inlineListToHtml opts capt cs <- inlineListToHtml opts capt
return $ caption cs +++ nl opts return $ H.caption cs >> nl opts
let percent w = show (truncate (100*w) :: Integer) ++ "%" let percent w = show (truncate (100*w) :: Integer) ++ "%"
let widthAttrs w = if writerHtml5 opts
then [thestyle $ "width: " ++ percent w]
else [width $ percent w]
let coltags = if all (== 0.0) widths let coltags = if all (== 0.0) widths
then noHtml then mempty
else concatHtml $ map else mconcat $ map (\w ->
(\w -> (col ! (widthAttrs w)) noHtml +++ nl opts) if writerHtml5 opts
then H.col ! A.style (toValue $ "width: " ++ percent w)
else H.col ! A.width (toValue $ percent w) >> nl opts)
widths widths
head' <- if all null headers head' <- if all null headers
then return noHtml then return mempty
else do else do
contents <- tableRowToHtml opts aligns 0 headers contents <- tableRowToHtml opts aligns 0 headers
return $ thead << (nl opts +++ contents) +++ nl opts return $ H.thead (nl opts >> contents) >> nl opts
body' <- liftM (\x -> tbody << (nl opts +++ x)) $ body' <- liftM (\x -> H.tbody (nl opts >> mconcat x)) $
zipWithM (tableRowToHtml opts aligns) [1..] rows' zipWithM (tableRowToHtml opts aligns) [1..] rows'
return $ table $ nl opts +++ captionDoc +++ coltags +++ head' +++ return $ H.table $ nl opts >> captionDoc >> coltags >> head' >>
body' +++ nl opts body' >> nl opts
tableRowToHtml :: WriterOptions tableRowToHtml :: WriterOptions
-> [Alignment] -> [Alignment]
@ -473,7 +479,7 @@ tableRowToHtml :: WriterOptions
-> [[Block]] -> [[Block]]
-> State WriterState Html -> State WriterState Html
tableRowToHtml opts aligns rownum cols' = do tableRowToHtml opts aligns rownum cols' = do
let mkcell = if rownum == 0 then th else td let mkcell = if rownum == 0 then H.th else H.td
let rowclass = case rownum of let rowclass = case rownum of
0 -> "header" 0 -> "header"
x | x `rem` 2 == 1 -> "odd" x | x `rem` 2 == 1 -> "odd"
@ -481,8 +487,8 @@ tableRowToHtml opts aligns rownum cols' = do
cols'' <- sequence $ zipWith cols'' <- sequence $ zipWith
(\alignment item -> tableItemToHtml opts mkcell alignment item) (\alignment item -> tableItemToHtml opts mkcell alignment item)
aligns cols' aligns cols'
return $ (tr ! [theclass rowclass] $ nl opts +++ toHtmlFromList cols'') return $ (H.tr ! A.class_ rowclass $ nl opts >> mconcat cols'')
+++ nl opts >> nl opts
alignmentToString :: Alignment -> [Char] alignmentToString :: Alignment -> [Char]
alignmentToString alignment = case alignment of alignmentToString alignment = case alignment of
@ -498,85 +504,87 @@ tableItemToHtml :: WriterOptions
-> State WriterState Html -> State WriterState Html
tableItemToHtml opts tag' align' item = do tableItemToHtml opts tag' align' item = do
contents <- blockListToHtml opts item contents <- blockListToHtml opts item
let alignAttrs = if writerHtml5 opts let alignStr = alignmentToString align'
then [thestyle $ "align: " ++ alignmentToString align'] let attribs = if writerHtml5 opts
else [align $ alignmentToString align'] then A.style (toValue $ "text-align: " ++ alignStr ++ ";")
return $ (tag' ! alignAttrs) contents +++ nl opts else A4.align (toValue alignStr)
return $ tag' ! attribs $ contents >> nl opts
toListItems :: WriterOptions -> [Html] -> [Html] toListItems :: WriterOptions -> [Html] -> [Html]
toListItems opts items = map (toListItem opts) items ++ [nl opts] toListItems opts items = map (toListItem opts) items ++ [nl opts]
toListItem :: WriterOptions -> Html -> Html toListItem :: WriterOptions -> Html -> Html
toListItem opts item = nl opts +++ li item toListItem opts item = nl opts >> H.li item
blockListToHtml :: WriterOptions -> [Block] -> State WriterState Html blockListToHtml :: WriterOptions -> [Block] -> State WriterState Html
blockListToHtml opts lst = blockListToHtml opts lst =
mapM (blockToHtml opts) lst >>= mapM (blockToHtml opts) lst >>=
return . toHtmlFromList . intersperse (nl opts) return . mconcat . intersperse (nl opts)
-- | Convert list of Pandoc inline elements to HTML. -- | Convert list of Pandoc inline elements to HTML.
inlineListToHtml :: WriterOptions -> [Inline] -> State WriterState Html inlineListToHtml :: WriterOptions -> [Inline] -> State WriterState Html
inlineListToHtml opts lst = inlineListToHtml opts lst =
mapM (inlineToHtml opts) lst >>= return . toHtmlFromList mapM (inlineToHtml opts) lst >>= return . mconcat
-- | Convert Pandoc inline element to HTML. -- | Convert Pandoc inline element to HTML.
inlineToHtml :: WriterOptions -> Inline -> State WriterState Html inlineToHtml :: WriterOptions -> Inline -> State WriterState Html
inlineToHtml opts inline = inlineToHtml opts inline =
case inline of case inline of
(Str str) -> return $ stringToHtml opts str (Str str) -> return $ strToHtml str
(Space) -> return $ stringToHtml opts " " (Space) -> return $ strToHtml " "
(LineBreak) -> return br (LineBreak) -> return H.br
(EmDash) -> return $ stringToHtml opts "—" (EmDash) -> return $ strToHtml "—"
(EnDash) -> return $ stringToHtml opts "–" (EnDash) -> return $ strToHtml "–"
(Ellipses) -> return $ stringToHtml opts "…" (Ellipses) -> return $ strToHtml "…"
(Apostrophe) -> return $ stringToHtml opts "’" (Apostrophe) -> return $ strToHtml "’"
(Emph lst) -> inlineListToHtml opts lst >>= return . emphasize (Emph lst) -> inlineListToHtml opts lst >>= return . H.em
(Strong lst) -> inlineListToHtml opts lst >>= return . strong (Strong lst) -> inlineListToHtml opts lst >>= return . H.strong
(Code attr str) -> case highlightHtml True attr str of (Code attr str) -> case highlightHtml True attr str of
Left _ -> return Left _ -> return
$ thecode ! (attrsToHtml opts attr) $ foldl (!) H.code (attrsToHtml opts attr)
$ stringToHtml opts str $ strToHtml str
Right h -> return h Right h -> return h
(Strikeout lst) -> inlineListToHtml opts lst >>= (Strikeout lst) -> inlineListToHtml opts lst >>=
return . (thespan ! [thestyle "text-decoration: line-through;"]) return . (H.span ! A.style "text-decoration: line-through;")
(SmallCaps lst) -> inlineListToHtml opts lst >>= (SmallCaps lst) -> inlineListToHtml opts lst >>=
return . (thespan ! [thestyle "font-variant: small-caps;"]) return . (H.span ! A.style "font-variant: small-caps;")
(Superscript lst) -> inlineListToHtml opts lst >>= return . sup (Superscript lst) -> inlineListToHtml opts lst >>= return . H.sup
(Subscript lst) -> inlineListToHtml opts lst >>= return . sub (Subscript lst) -> inlineListToHtml opts lst >>= return . H.sub
(Quoted quoteType lst) -> (Quoted quoteType lst) ->
let (leftQuote, rightQuote) = case quoteType of let (leftQuote, rightQuote) = case quoteType of
SingleQuote -> (stringToHtml opts "‘", SingleQuote -> (strToHtml "‘",
stringToHtml opts "’") strToHtml "’")
DoubleQuote -> (stringToHtml opts "“", DoubleQuote -> (strToHtml "“",
stringToHtml opts "”") strToHtml "”")
in do contents <- inlineListToHtml opts lst in do contents <- inlineListToHtml opts lst
return $ leftQuote +++ contents +++ rightQuote return $ leftQuote >> contents >> rightQuote
(Math t str) -> modify (\st -> st {stMath = True}) >> (Math t str) -> modify (\st -> st {stMath = True}) >>
(case writerHTMLMathMethod opts of (case writerHTMLMathMethod opts of
LaTeXMathML _ -> LaTeXMathML _ ->
-- putting LaTeXMathML in container with class "LaTeX" prevents -- putting LaTeXMathML in container with class "LaTeX" prevents
-- non-math elements on the page from being treated as math by -- non-math elements on the page from being treated as math by
-- the javascript -- the javascript
return $ thespan ! [theclass "LaTeX"] $ return $ H.span ! A.class_ "LaTeX" $
case t of case t of
InlineMath -> primHtml ("$" ++ str ++ "$") InlineMath -> toHtml ("$" ++ str ++ "$")
DisplayMath -> primHtml ("$$" ++ str ++ "$$") DisplayMath -> toHtml ("$$" ++ str ++ "$$")
JsMath _ -> do JsMath _ -> do
let m = primHtml str let m = preEscapedString str
return $ case t of return $ case t of
InlineMath -> thespan ! [theclass "math"] $ m InlineMath -> H.span ! A.class_ "math" $ m
DisplayMath -> thediv ! [theclass "math"] $ m DisplayMath -> H.div ! A.class_ "math" $ m
WebTeX url -> do WebTeX url -> do
let m = image ! [thestyle "vertical-align:middle", let m = H.img ! A.style "vertical-align:middle"
src (url ++ urlEncode str), ! A.src (toValue $ url ++ urlEncode str)
alt str, title str] ! A.alt (toValue str)
! A.title (toValue str)
return $ case t of return $ case t of
InlineMath -> m InlineMath -> m
DisplayMath -> br +++ m +++ br DisplayMath -> H.br >> m >> H.br
GladTeX -> GladTeX ->
return $ case t of return $ case t of
InlineMath -> primHtml $ "<EQ ENV=\"math\">" ++ str ++ "</EQ>" InlineMath -> preEscapedString "<EQ ENV=\"math\">" >> toHtml str >> preEscapedString "</EQ>"
DisplayMath -> primHtml $ "<EQ ENV=\"displaymath\">" ++ str ++ "</EQ>" DisplayMath -> preEscapedString "<EQ ENV=\"displaymath\">" >> toHtml str >> preEscapedString "</EQ>"
MathML _ -> do MathML _ -> do
let dt = if t == InlineMath let dt = if t == InlineMath
then DisplayInline then DisplayInline
@ -584,54 +592,55 @@ inlineToHtml opts inline =
let conf = useShortEmptyTags (const False) let conf = useShortEmptyTags (const False)
defaultConfigPP defaultConfigPP
case texMathToMathML dt str of case texMathToMathML dt str of
Right r -> return $ primHtml $ Right r -> return $ preEscapedString $
ppcElement conf r ppcElement conf r
Left _ -> inlineListToHtml opts Left _ -> inlineListToHtml opts
(readTeXMath str) >>= return . (readTeXMath str) >>= return .
(thespan ! [theclass "math"]) (H.span ! A.class_ "math")
MathJax _ -> return $ primHtml $ MathJax _ -> return $ toHtml $
case t of case t of
InlineMath -> "\\(" ++ str ++ "\\)" InlineMath -> "\\(" ++ str ++ "\\)"
DisplayMath -> "\\[" ++ str ++ "\\]" DisplayMath -> "\\[" ++ str ++ "\\]"
PlainMath -> do PlainMath -> do
x <- inlineListToHtml opts (readTeXMath str) x <- inlineListToHtml opts (readTeXMath str)
let m = thespan ! [theclass "math"] $ x let m = H.span ! A.class_ "math" $ x
return $ case t of return $ case t of
InlineMath -> m InlineMath -> m
DisplayMath -> br +++ m +++ br ) DisplayMath -> H.br >> m >> H.br )
(RawInline "latex" str) -> case writerHTMLMathMethod opts of (RawInline "latex" str) -> case writerHTMLMathMethod opts of
LaTeXMathML _ -> do modify (\st -> st {stMath = True}) LaTeXMathML _ -> do modify (\st -> st {stMath = True})
return $ primHtml str return $ toHtml str
_ -> return noHtml _ -> return mempty
(RawInline "html" str) -> return $ primHtml str (RawInline "html" str) -> return $ preEscapedString str
(RawInline _ _) -> return noHtml (RawInline _ _) -> return mempty
(Link [Code _ str] (s,_)) | "mailto:" `isPrefixOf` s -> (Link [Code _ str] (s,_)) | "mailto:" `isPrefixOf` s ->
return $ obfuscateLink opts str s return $ obfuscateLink opts str s
(Link txt (s,_)) | "mailto:" `isPrefixOf` s -> do (Link txt (s,_)) | "mailto:" `isPrefixOf` s -> do
linkText <- inlineListToHtml opts txt linkText <- inlineListToHtml opts txt
return $ obfuscateLink opts (show linkText) s return $ obfuscateLink opts (renderHtml linkText) s
(Link txt (s,tit)) -> do (Link txt (s,tit)) -> do
linkText <- inlineListToHtml opts txt linkText <- inlineListToHtml opts txt
return $ anchor ! ([href s] ++ let link = H.a ! A.href (toValue s) $ linkText
if null tit then [] else [title tit]) $ return $ if null tit
linkText then link
else link ! A.title (toValue tit)
(Image txt (s,tit)) | treatAsImage s -> do (Image txt (s,tit)) | treatAsImage s -> do
let alternate' = stringify txt let alternate' = stringify txt
let attributes = [src s] ++ let attributes = [A.src $ toValue s] ++
(if null tit (if null tit
then [] then []
else [title tit]) ++ else [A.title $ toValue tit]) ++
if null txt if null txt
then [] then []
else [alt alternate'] else [A.alt $ toValue alternate']
return $ image ! attributes return $ foldl (!) H.img attributes
-- note: null title included, as in Markdown.pl -- note: null title included, as in Markdown.pl
(Image _ (s,tit)) -> do (Image _ (s,tit)) -> do
let attributes = [src s] ++ let attributes = [A.src $ toValue s] ++
(if null tit (if null tit
then [] then []
else [title tit]) else [A.title $ toValue tit])
return $ itag "embed" ! attributes return $ foldl (!) H.embed attributes
-- note: null title included, as in Markdown.pl -- note: null title included, as in Markdown.pl
(Note contents) -> do (Note contents) -> do
st <- get st <- get
@ -641,20 +650,20 @@ inlineToHtml opts inline =
htmlContents <- blockListToNote opts ref contents htmlContents <- blockListToNote opts ref contents
-- push contents onto front of notes -- push contents onto front of notes
put $ st {stNotes = (htmlContents:notes)} put $ st {stNotes = (htmlContents:notes)}
return $ sup << return $ H.sup $
anchor ! [href ("#" ++ writerIdentifierPrefix opts ++ "fn" ++ ref), H.a ! A.href (toValue $ "#" ++ writerIdentifierPrefix opts ++ "fn" ++ ref)
theclass "footnoteRef", ! A.class_ "footnoteRef"
prefixedId opts ("fnref" ++ ref)] << ref ! prefixedId opts ("fnref" ++ ref)
$ toHtml ref
(Cite _ il) -> do contents <- inlineListToHtml opts il (Cite _ il) -> do contents <- inlineListToHtml opts il
return $ thespan ! [theclass "citation"] << contents return $ H.span ! A.class_ "citation" $ contents
blockListToNote :: WriterOptions -> String -> [Block] -> State WriterState Html blockListToNote :: WriterOptions -> String -> [Block] -> State WriterState Html
blockListToNote opts ref blocks = blockListToNote opts ref blocks =
-- If last block is Para or Plain, include the backlink at the end of -- If last block is Para or Plain, include the backlink at the end of
-- that block. Otherwise, insert a new Plain block with the backlink. -- that block. Otherwise, insert a new Plain block with the backlink.
let backlink = [RawInline "html" $ " <a href=\"#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref ++ let backlink = [RawInline "html" $ " <a href=\"#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref ++
"\" class=\"footnoteBackLink\">" ++ "\" class=\"footnoteBackLink\">↩</a>"]
(if writerAscii opts then "&#8617;" else "↩") ++ "</a>"]
blocks' = if null blocks blocks' = if null blocks
then [] then []
else let lastBlock = last blocks else let lastBlock = last blocks
@ -667,4 +676,4 @@ blockListToNote opts ref blocks =
_ -> otherBlocks ++ [lastBlock, _ -> otherBlocks ++ [lastBlock,
Plain backlink] Plain backlink]
in do contents <- blockListToHtml opts blocks' in do contents <- blockListToHtml opts blocks'
return $ nl opts +++ (li ! [prefixedId opts ("fn" ++ ref)]) contents return $ nl opts >> (H.li ! (prefixedId opts ("fn" ++ ref)) $ contents)

11
src/pandoc.hs
View file

@ -126,7 +126,6 @@ data Opt = Opt
, optCslFile :: FilePath , optCslFile :: FilePath
, optAbbrevsFile :: Maybe FilePath , optAbbrevsFile :: Maybe FilePath
, optListings :: Bool -- ^ Use listings package for code blocks , optListings :: Bool -- ^ Use listings package for code blocks
, optAscii :: Bool -- ^ Avoid using nonascii characters
} }
-- | Defaults for command-line options. -- | Defaults for command-line options.
@ -171,7 +170,6 @@ defaultOpts = Opt
, optCslFile = "" , optCslFile = ""
, optAbbrevsFile = Nothing , optAbbrevsFile = Nothing
, optListings = False , optListings = False
, optAscii = False
} }
-- | A list of functions, each transforming the options data structure -- | A list of functions, each transforming the options data structure
@ -369,11 +367,6 @@ options =
"NUMBER") "NUMBER")
"" -- "Length of line in characters" "" -- "Length of line in characters"
, Option "" ["ascii"]
(NoArg
(\opt -> return opt { optAscii = True }))
"" -- "Avoid using non-ascii characters in output"
, Option "" ["email-obfuscation"] , Option "" ["email-obfuscation"]
(ReqArg (ReqArg
(\arg opt -> do (\arg opt -> do
@ -723,7 +716,6 @@ main = do
, optAbbrevsFile = cslabbrevs , optAbbrevsFile = cslabbrevs
, optCiteMethod = citeMethod , optCiteMethod = citeMethod
, optListings = listings , optListings = listings
, optAscii = ascii
} = opts } = opts
when dumpArgs $ when dumpArgs $
@ -847,8 +839,7 @@ main = do
writerHtml5 = html5 || writerHtml5 = html5 ||
slideVariant == DZSlides, slideVariant == DZSlides,
writerChapters = chapters, writerChapters = chapters,
writerListings = listings, writerListings = listings }
writerAscii = ascii }
when (isNonTextOutput writerName' && outputFile == "-") $ when (isNonTextOutput writerName' && outputFile == "-") $
do UTF8.hPutStrLn stderr ("Error: Cannot write " ++ writerName' ++ " output to stdout.\n" ++ do UTF8.hPutStrLn stderr ("Error: Cannot write " ++ writerName' ++ " output to stdout.\n" ++