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

HTML writer: More normal line breaks.

Browse source 
Also removes any distinction between --no-wrap and default HTML
output.

Resolves Issue #134.
This commit is contained in:
John MacFarlane 2011-02-03 17:30:38 -08:00
parent 1a19f96a5b
commit f9dcea6655
1 changed files with 29 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -58,16 +58,15 @@ defaultWriterState = WriterState {stNotes= [], stMath = False, stHighlighting =
-- Helpers to render HTML with the appropriate function. -- Helpers to render HTML with the appropriate function.
renderFragment :: (HTML html) => WriterOptions -> html -> String
renderFragment opts = if writerWrapText opts
then renderHtmlFragment
else showHtmlFragment
-- | Modified version of Text.XHtml's stringToHtml. -- | Modified version of Text.XHtml's stringToHtml.
-- Use unicode characters wherever possible. -- Use unicode characters wherever possible.
stringToHtml :: String -> Html stringToHtml :: String -> Html
stringToHtml = primHtml . escapeStringForXML stringToHtml = primHtml . escapeStringForXML
-- | Hard linebreak.
nl :: Html
nl = primHtml "\n"
-- | Convert Pandoc document to Html string. -- | Convert Pandoc document to Html string.
writeHtmlString :: WriterOptions -> Pandoc -> String writeHtmlString :: WriterOptions -> Pandoc -> String
writeHtmlString opts d = writeHtmlString opts d =
@ -75,7 +74,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 renderFragment opts body' else showHtmlFragment body'
-- | Convert Pandoc document to Html structure. -- | Convert Pandoc document to Html structure.
writeHtml :: WriterOptions -> Pandoc -> Html writeHtml :: WriterOptions -> Pandoc -> Html
@ -306,20 +305,22 @@ attrsToHtml opts (id',classes',keyvals) =
-- | 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 noHtml
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 tag "figure" <<
[img, tag "figcaption" << capt] [img, tag "figcaption" << capt] +++ nl
else thediv ! [theclass "figure"] << else thediv ! [theclass "figure"] <<
[img, paragraph ! [theclass "caption"] << capt] [img, paragraph ! [theclass "caption"] << capt] +++ nl
blockToHtml opts (Para lst) = inlineListToHtml opts lst >>= (return . paragraph) blockToHtml opts (Para lst) = do
contents <- inlineListToHtml opts lst
return $ paragraph contents +++ nl
blockToHtml _ (RawBlock "html" str) = return $ primHtml str blockToHtml _ (RawBlock "html" str) = return $ primHtml str
blockToHtml _ (RawBlock _ _) = return noHtml blockToHtml _ (RawBlock _ _) = return noHtml
blockToHtml _ (HorizontalRule) = return $ hr blockToHtml _ (HorizontalRule) = return $ hr +++ nl
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
@ -334,8 +335,9 @@ blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
else unlines . lines else unlines . lines
in return $ pre ! attrs $ thecode << in return $ pre ! attrs $ thecode <<
(replicate (length leadingBreaks) br +++ (replicate (length leadingBreaks) br +++
[stringToHtml $ addBird rawCode']) [stringToHtml $ addBird rawCode']) +++ nl
Right h -> modify (\st -> st{ stHighlighting = True }) >> return h Right h -> modify (\st -> st{ stHighlighting = True }) >>
return (h +++ nl)
blockToHtml opts (BlockQuote blocks) = blockToHtml opts (BlockQuote blocks) =
-- in S5, treat list in blockquote specially -- in S5, treat list in blockquote specially
-- if default is incremental, make it nonincremental; -- if default is incremental, make it nonincremental;
@ -350,7 +352,9 @@ blockToHtml opts (BlockQuote blocks) =
(OrderedList attribs lst) (OrderedList attribs lst)
_ -> blockListToHtml opts blocks >>= _ -> blockListToHtml opts blocks >>=
(return . blockquote) (return . blockquote)
else blockListToHtml opts blocks >>= (return . blockquote) else do
contents <- blockListToHtml opts blocks
return $ blockquote contents +++ nl
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
@ -361,20 +365,20 @@ blockToHtml opts (Header level lst) = do
let contents'' = if writerTableOfContents opts let contents'' = if writerTableOfContents opts
then anchor ! [href $ "#" ++ writerIdentifierPrefix opts ++ "TOC"] $ contents' then anchor ! [href $ "#" ++ writerIdentifierPrefix opts ++ "TOC"] $ contents'
else contents' else contents'
return $ case level of return $ (case level of
1 -> h1 contents'' 1 -> h1 contents''
2 -> h2 contents'' 2 -> h2 contents''
3 -> h3 contents'' 3 -> h3 contents''
4 -> h4 contents'' 4 -> h4 contents''
5 -> h5 contents'' 5 -> h5 contents''
6 -> h6 contents'' 6 -> h6 contents''
_ -> paragraph contents'' _ -> paragraph contents'') +++ nl
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 attribs = if writerIncremental opts
then [theclass "incremental"] then [theclass "incremental"]
else [] else []
return $ unordList ! attribs $ contents return $ (unordList ! attribs) contents +++ nl
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
@ -397,16 +401,16 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
else [thestyle $ "list-style-type: " ++ else [thestyle $ "list-style-type: " ++
numstyle'] numstyle']
else []) else [])
return $ ordList ! attribs $ contents return $ (ordList ! attribs) contents +++ nl
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 (dterm <<) $ inlineListToHtml opts term
defs' <- mapM (liftM (ddef <<) . blockListToHtml opts) defs defs' <- mapM (liftM (ddef <<) . blockListToHtml opts) defs
return $ term' : defs') lst return $ nl : term' : nl : defs') lst
let attribs = if writerIncremental opts let attribs = if writerIncremental opts
then [theclass "incremental"] then [theclass "incremental"]
else [] else []
return $ dlist ! attribs << concat contents return $ (dlist ! attribs << concat contents) +++ nl
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 noHtml
@ -424,7 +428,7 @@ blockToHtml opts (Table capt aligns widths headers rows') = do
else liftM (thead <<) $ tableRowToHtml opts aligns 0 headers else liftM (thead <<) $ tableRowToHtml opts aligns 0 headers
body' <- liftM (tbody <<) $ body' <- liftM (tbody <<) $
zipWithM (tableRowToHtml opts aligns) [1..] rows' zipWithM (tableRowToHtml opts aligns) [1..] rows'
return $ table $ captionDoc +++ coltags +++ head' +++ body' return $ table $ captionDoc +++ coltags +++ head' +++ body' +++ nl
tableRowToHtml :: WriterOptions tableRowToHtml :: WriterOptions
-> [Alignment] -> [Alignment]
@ -440,7 +444,7 @@ 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] $ toHtmlFromList cols'' return $ (tr ! [theclass rowclass] $ toHtmlFromList cols'') +++ nl
alignmentToString :: Alignment -> [Char] alignmentToString :: Alignment -> [Char]
alignmentToString alignment = case alignment of alignmentToString alignment = case alignment of
@ -459,7 +463,7 @@ tableItemToHtml opts tag' align' item = do
let alignAttrs = if writerHtml5 opts let alignAttrs = if writerHtml5 opts
then [thestyle $ "align: " ++ alignmentToString align'] then [thestyle $ "align: " ++ alignmentToString align']
else [align $ alignmentToString align'] else [align $ alignmentToString align']
return $ tag' ! alignAttrs $ contents return $ (tag' ! alignAttrs) contents +++ nl
blockListToHtml :: WriterOptions -> [Block] -> State WriterState Html blockListToHtml :: WriterOptions -> [Block] -> State WriterState Html
blockListToHtml opts lst = blockListToHtml opts lst =
@ -567,7 +571,7 @@ inlineToHtml opts inline =
linkText linkText
(Image txt (s,tit)) -> do (Image txt (s,tit)) -> do
alternate <- inlineListToHtml opts txt alternate <- inlineListToHtml opts txt
let alternate' = renderFragment opts alternate let alternate' = showHtmlFragment alternate
let attributes = [src s] ++ let attributes = [src s] ++
(if null tit (if null tit
then [] then []
@ -610,5 +614,5 @@ 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 $ li ! [prefixedId opts ("fn" ++ ref)] $ contents return $ nl +++ (li ! [prefixedId opts ("fn" ++ ref)]) contents