39f6af5 · typeable/pandoc

git.iko.soy/typeable/pandoc

Modified html+lhs output to use 'haskell' highlighter.

The bird tracks are added in the highlighting module. This makes sense, because the kate's haskell highlighter is much better than the literateHaskell highlighter. git-svn-id: https://pandoc.googlecode.com/svn/trunk@1620 788f1e2b-df1e-0410-8736-df70ead52e1b

commit39f6af5de4f4059239fbeda4095d8f92b98912d3 authorfiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b> dateSat 21 Nov 2009, 04:40 (17 years ago) parent9d20eeb

4 files changed+37−34

compare with master

unifiedsplit

src/Text/Pandoc/Highlighting.hs+5−1 src/Text/Pandoc/Writers/HTML.hs+12−13 tests/lhs-test.fragment.html+lhs+10−10 tests/lhs-test.html+lhs+10−10

src/Text/Pandoc/Highlighting.hs+5−1

@@ -45,12 +45,16 @@ highlightHtml (_, classes, keyvals) rawCode =

4545 case find (`elem` ["number","numberLines","number-lines"]) classes of

4646 Nothing -> []

4747 Just _ -> [OptNumberLines]

48+ addBirdTracks = "literate" `elem` classes

4849 lcLanguages = map (map toLower) languages

4950 in case find (\c -> (map toLower c) `elem` lcLanguages) classes of

5051 Nothing -> Left "Unknown or unsupported language"

5152 Just language -> case highlightAs language rawCode of

5253 Left err -> Left err

53− Right hl -> Right $ formatAsXHtml fmtOpts language hl

54+ Right hl -> Right $ formatAsXHtml fmtOpts language $

55+ if addBirdTracks

56+ then map ((["Special"],"> "):) hl

57+ else hl

5458

5559#else

5660defaultHighlightingCss :: String

src/Text/Pandoc/Writers/HTML.hs+12−13

@@ -37,7 +37,7 @@ import Text.Pandoc.Readers.TeXMath

3737import Text.Pandoc.Highlighting ( highlightHtml, defaultHighlightingCss )

3838import Numeric ( showHex )

3939import Data.Char ( ord, toLower )

40−import Data.List ( isPrefixOf, intercalate )

40+import Data.List ( isPrefixOf )

4141import Data.Maybe ( catMaybes )

4242import qualified Data.Set as S

4343import Control.Monad.State

@@ -248,21 +248,20 @@ blockToHtml opts (Plain lst) = inlineListToHtml opts lst

248248blockToHtml opts (Para lst) = inlineListToHtml opts lst >>= (return . paragraph)

249249blockToHtml _ (RawHtml str) = return $ primHtml str

250250blockToHtml _ (HorizontalRule) = return $ hr

251−blockToHtml opts (CodeBlock (_,classes,_) rawCode) | "haskell" `elem` classes &&

252− "literate" `elem` classes &&

253− writerLiterateHaskell opts =

254− let classes' = map (\c -> if c == "haskell" then "literatehaskell" else c) classes

255− in blockToHtml opts $ CodeBlock ("",classes',[]) $ intercalate "\n" $ map ("> " ++) $ lines rawCode

256−blockToHtml _ (CodeBlock attr@(_,classes,_) rawCode) = do

257− case highlightHtml attr rawCode of

251+blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do

252+ let classes' = if writerLiterateHaskell opts

253+ then classes

254+ else filter (/= "literate") classes

255+ case highlightHtml (id',classes',keyvals) rawCode of

258256 Left _ -> -- change leading newlines into <br /> tags, because some

259257 -- browsers ignore leading newlines in pre blocks

260258 let (leadingBreaks, rawCode') = span (=='\n') rawCode

261− in return $ pre ! (if null classes

262− then []

263− else [theclass $ unwords classes]) $ thecode <<

264− (replicate (length leadingBreaks) br +++

265− [stringToHtml $ rawCode' ++ "\n"])

259+ attrs = [theclass (unwords classes') | not (null classes')] ++

260+ [identifier id' | not (null id')] ++

261+ map (\(x,y) -> strAttr x y) keyvals

262+ in return $ pre ! attrs $ thecode <<

263+ (replicate (length leadingBreaks) br +++

264+ [stringToHtml $ rawCode' ++ "\n"])

266265 Right h -> addToCSS defaultHighlightingCss >> return h

267266blockToHtml opts (BlockQuote blocks) =

268267 -- in S5, treat list in blockquote specially

tests/lhs-test.fragment.html+lhs+10−10

@@ -5,28 +5,28 @@

55 ><code

66 >unsplit</code

77 > is an arrow that takes a pair of values and combines them to return a single value:</p

8− ><pre class="sourceCode literatehaskell"

8+ ><pre class="sourceCode haskell"

99 ><code

10− ><span class="Char Special"

11− >></span

10+ ><span class="Special"

11+ >> </span

1212 ><span class="Function FunctionDefinition"

13− > unsplit ::</span

13+ >unsplit ::</span

1414 ><span class="Normal NormalText"

1515 > (Arrow a) => (b -> c -> d) -> a (b, c) d</span

1616 ><br

17− /><span class="Char Special"

18− >></span

17+ /><span class="Special"

18+ >> </span

1919 ><span class="Normal NormalText"

20− > unsplit = arr . </span

20+ >unsplit = arr . </span

2121 ><span class="Function"

2222 >uncurry</span

2323 ><span class="Normal NormalText"

2424 > </span

2525 ><br

26− /><span class="Char Special"

27− >></span

26+ /><span class="Special"

27+ >> </span

2828 ><span class="Normal NormalText"

29− > </span

29+ > </span

3030 ><span class="Comment"

3131 >-- arr (\op (x,y) -> x `op` y) </span

3232 ><br

tests/lhs-test.html+lhs+10−10

@@ -36,28 +36,28 @@ pre.sourceCode span.Error { color: red; font-weight: bold; }

3636 ><code

3737 >unsplit</code

3838 > is an arrow that takes a pair of values and combines them to return a single value:</p

39− ><pre class="sourceCode literatehaskell"

39+ ><pre class="sourceCode haskell"

4040 ><code

41− ><span class="Char Special"

42− >></span

41+ ><span class="Special"

42+ >> </span

4343 ><span class="Function FunctionDefinition"

44− > unsplit ::</span

44+ >unsplit ::</span

4545 ><span class="Normal NormalText"

4646 > (Arrow a) => (b -> c -> d) -> a (b, c) d</span

4747 ><br

48− /><span class="Char Special"

49− >></span

48+ /><span class="Special"

49+ >> </span

5050 ><span class="Normal NormalText"

51− > unsplit = arr . </span

51+ >unsplit = arr . </span

5252 ><span class="Function"

5353 >uncurry</span

5454 ><span class="Normal NormalText"

5555 > </span

5656 ><br

57− /><span class="Char Special"

58− >></span

57+ /><span class="Special"

58+ >> </span

5959 ><span class="Normal NormalText"

60− > </span

60+ > </span

6161 ><span class="Comment"

6262 >-- arr (\op (x,y) -> x `op` y) </span

6363 ><br