diff options
| -rw-r--r-- | src/Text/Pandoc/Highlighting.hs | 6 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 25 | ||||
| -rw-r--r-- | tests/lhs-test.fragment.html+lhs | 20 | ||||
| -rw-r--r-- | tests/lhs-test.html+lhs | 20 |
4 files changed, 37 insertions, 34 deletions
diff --git a/src/Text/Pandoc/Highlighting.hs b/src/Text/Pandoc/Highlighting.hs index 6a88e5d70..457e605a5 100644 --- a/src/Text/Pandoc/Highlighting.hs +++ b/src/Text/Pandoc/Highlighting.hs @@ -45,12 +45,16 @@ highlightHtml (_, classes, keyvals) rawCode = case find (`elem` ["number","numberLines","number-lines"]) classes of Nothing -> [] Just _ -> [OptNumberLines] + addBirdTracks = "literate" `elem` classes lcLanguages = map (map toLower) languages in case find (\c -> (map toLower c) `elem` lcLanguages) classes of Nothing -> Left "Unknown or unsupported language" Just language -> case highlightAs language rawCode of Left err -> Left err - Right hl -> Right $ formatAsXHtml fmtOpts language hl + Right hl -> Right $ formatAsXHtml fmtOpts language $ + if addBirdTracks + then map ((["Special"],"> "):) hl + else hl #else defaultHighlightingCss :: String diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 28d0daacc..3f8bf3637 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -37,7 +37,7 @@ import Text.Pandoc.Readers.TeXMath import Text.Pandoc.Highlighting ( highlightHtml, defaultHighlightingCss ) import Numeric ( showHex ) import Data.Char ( ord, toLower ) -import Data.List ( isPrefixOf, intercalate ) +import Data.List ( isPrefixOf ) import Data.Maybe ( catMaybes ) import qualified Data.Set as S import Control.Monad.State @@ -248,21 +248,20 @@ blockToHtml opts (Plain lst) = inlineListToHtml opts lst blockToHtml opts (Para lst) = inlineListToHtml opts lst >>= (return . paragraph) blockToHtml _ (RawHtml str) = return $ primHtml str blockToHtml _ (HorizontalRule) = return $ hr -blockToHtml opts (CodeBlock (_,classes,_) rawCode) | "haskell" `elem` classes && - "literate" `elem` classes && - writerLiterateHaskell opts = - let classes' = map (\c -> if c == "haskell" then "literatehaskell" else c) classes - in blockToHtml opts $ CodeBlock ("",classes',[]) $ intercalate "\n" $ map ("> " ++) $ lines rawCode -blockToHtml _ (CodeBlock attr@(_,classes,_) rawCode) = do - case highlightHtml attr rawCode of +blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do + let classes' = if writerLiterateHaskell opts + then classes + else filter (/= "literate") classes + case highlightHtml (id',classes',keyvals) rawCode of Left _ -> -- change leading newlines into <br /> tags, because some -- browsers ignore leading newlines in pre blocks let (leadingBreaks, rawCode') = span (=='\n') rawCode - in return $ pre ! (if null classes - then [] - else [theclass $ unwords classes]) $ thecode << - (replicate (length leadingBreaks) br +++ - [stringToHtml $ rawCode' ++ "\n"]) + attrs = [theclass (unwords classes') | not (null classes')] ++ + [identifier id' | not (null id')] ++ + map (\(x,y) -> strAttr x y) keyvals + in return $ pre ! attrs $ thecode << + (replicate (length leadingBreaks) br +++ + [stringToHtml $ rawCode' ++ "\n"]) Right h -> addToCSS defaultHighlightingCss >> return h blockToHtml opts (BlockQuote blocks) = -- in S5, treat list in blockquote specially diff --git a/tests/lhs-test.fragment.html+lhs b/tests/lhs-test.fragment.html+lhs index 2100db251..fec6bb750 100644 --- a/tests/lhs-test.fragment.html+lhs +++ b/tests/lhs-test.fragment.html+lhs @@ -5,28 +5,28 @@ ><code >unsplit</code > is an arrow that takes a pair of values and combines them to return a single value:</p - ><pre class="sourceCode literatehaskell" + ><pre class="sourceCode haskell" ><code - ><span class="Char Special" - >></span + ><span class="Special" + >> </span ><span class="Function FunctionDefinition" - > unsplit ::</span + >unsplit ::</span ><span class="Normal NormalText" > (Arrow a) => (b -> c -> d) -> a (b, c) d</span ><br - /><span class="Char Special" - >></span + /><span class="Special" + >> </span ><span class="Normal NormalText" - > unsplit = arr . </span + >unsplit = arr . </span ><span class="Function" >uncurry</span ><span class="Normal NormalText" > </span ><br - /><span class="Char Special" - >></span + /><span class="Special" + >> </span ><span class="Normal NormalText" - > </span + > </span ><span class="Comment" >-- arr (\op (x,y) -> x `op` y) </span ><br diff --git a/tests/lhs-test.html+lhs b/tests/lhs-test.html+lhs index d57ffc652..2c6cc2aa7 100644 --- a/tests/lhs-test.html+lhs +++ b/tests/lhs-test.html+lhs @@ -36,28 +36,28 @@ pre.sourceCode span.Error { color: red; font-weight: bold; } ><code >unsplit</code > is an arrow that takes a pair of values and combines them to return a single value:</p - ><pre class="sourceCode literatehaskell" + ><pre class="sourceCode haskell" ><code - ><span class="Char Special" - >></span + ><span class="Special" + >> </span ><span class="Function FunctionDefinition" - > unsplit ::</span + >unsplit ::</span ><span class="Normal NormalText" > (Arrow a) => (b -> c -> d) -> a (b, c) d</span ><br - /><span class="Char Special" - >></span + /><span class="Special" + >> </span ><span class="Normal NormalText" - > unsplit = arr . </span + >unsplit = arr . </span ><span class="Function" >uncurry</span ><span class="Normal NormalText" > </span ><br - /><span class="Char Special" - >></span + /><span class="Special" + >> </span ><span class="Normal NormalText" - > </span + > </span ><span class="Comment" >-- arr (\op (x,y) -> x `op` y) </span ><br |