04b3245 · typeable/pandoc

git.iko.soy/typeable/pandoc

Added build option for syntax highlighting, with *optional* dependency on highlighting-kate.

+ pandoc.cabal includes a flag, 'highlighting', that causes a dependency on highlighting-kate. + if Setup.hs detects this dependency, it copies templates/Highlighting.yes.hs to Text/Pandoc/Highlighting.hs. Otherwise, it copies templates/Highlighting.no.hs. + The HTML writer imports this new module instead of Text.Highlighting.Kate. The new module exports highlightHtml, which either uses highlighting-kate to perform syntax highlighting or automatically returns a failure code, depending on whether highlighting support was selected. + --version now prints information about whether syntax highlighting support is compiled in. git-svn-id: https://pandoc.googlecode.com/svn/trunk@1221 788f1e2b-df1e-0410-8736-df70ead52e1b

commit04b32451be96cc64e3c8ee37a4b099ffe6236146 authorfiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b> dateSat 9 Feb 2008, 03:21 (19 years ago) parent427c2e4

6 files changed+118−16

compare with master

unifiedsplit

Main.hs+7−1 Setup.hs+10−1 Text/Pandoc/Writers/HTML.hs+7−13 pandoc.cabal+7−1 templates/Highlighting.no.hs+39 templates/Highlighting.yes.hs+48

Main.hs+7−1

@@ -32,6 +32,7 @@ module Main where

3232import Text.Pandoc

3333import Text.Pandoc.UTF8

3434import Text.Pandoc.Shared ( joinWithSep, HTMLMathMethod (..) )

35+import Text.Pandoc.Highlighting ( languages )

3536import System.Environment ( getArgs, getProgName, getEnvironment )

3637import System.Exit ( exitWith, ExitCode (..) )

3738import System.FilePath ( takeExtension )

4748 \This is free software; see the source for copying conditions. There is no\n\

4849 \warranty, not even for merchantability or fitness for a particular purpose."

4950

51+compileOptions :: String

52+compileOptions = if null languages

53+ then " [compiled without syntax highlighting support]"

54+ else " [compiled with syntax highlighting support]"

55+

5056-- | Association list of formats and readers.

5157readers :: [(String, ParserState -> String -> Pandoc)]

5258readers = [("native" , readPandoc)

@@ -315,7 +321,7 @@ options =

315321 (NoArg

316322 (\_ -> do

317323 prg <- getProgName

318− hPutStrLn stderr (prg ++ " " ++ pandocVersion ++

324+ hPutStrLn stderr (prg ++ " " ++ pandocVersion ++ compileOptions ++

319325 copyrightMessage)

320326 exitWith $ ExitFailure 4))

321327 "" -- "Print version"

Setup.hs+10−1

@@ -3,7 +3,7 @@ import Distribution.Simple.Setup

33import Distribution.PackageDescription

44import Distribution.Simple.LocalBuildInfo

55import System.FilePath (combine, joinPath, takeFileName)

6−import System.Directory (getDirectoryContents, removeFile)

6+import System.Directory (getDirectoryContents, removeFile, copyFile)

77import System.IO (readFile, writeFile)

88import Control.Monad (foldM)

99import Data.List (isPrefixOf)

@@ -22,6 +22,14 @@ myPostConf _ configFlags pkgDescription buildInfo = do

2222 fillAsciiMathMLTemplate

2323 fillS5WriterTemplate

2424 fillDefaultHeadersTemplate

25+ let deps = packageDeps buildInfo

26+ let highlighting = any (\id -> pkgName id == "highlighting-kate") deps

27+ let highlightingModule = if highlighting

28+ then combine "templates" "Highlighting.yes.hs"

29+ else combine "templates" "Highlighting.no.hs"

30+ copyFile highlightingModule $ joinPath ["Text", "Pandoc", "Highlighting.hs"]

31+ putStrLn $ " Text/Pandoc/Highlighting.hs [" ++

32+ (if highlighting then "with" else "without") ++ " syntax highlighting support]"

2533

2634-- Fill templateFile with data in dataFiles and write to outputFile.

2735fillTemplate :: [FilePath] -> FilePath -> FilePath -> IO ()

@@ -53,6 +61,7 @@ myPostClean _ _ _ _ = do

5361 putStrLn "Removing source files generated from templates:"

5462 removeGeneratedFile $ joinPath [pandocPath, "ASCIIMathML.hs"]

5563 removeGeneratedFile $ joinPath [pandocPath, "DefaultHeaders.hs"]

64+ removeGeneratedFile $ joinPath [pandocPath, "Highlighting.hs"]

5665 removeGeneratedFile $ joinPath [pandocPath, "Writers", "S5.hs"]

5766

5867-- Remove file and print message.

Text/Pandoc/Writers/HTML.hs+7−13

@@ -33,13 +33,13 @@ import Text.Pandoc.ASCIIMathML

3333import Text.Pandoc.CharacterReferences ( decodeCharacterReferences )

3434import Text.Pandoc.Shared

3535import Text.Pandoc.Readers.TeXMath

36+import Text.Pandoc.Highlighting ( highlightHtml )

3637import Numeric ( showHex )

3738import Data.Char ( ord, toLower, isAlpha )

3839import Data.List ( isPrefixOf, intersperse, find )

3940import qualified Data.Set as S

4041import Control.Monad.State

4142import Text.XHtml.Transitional

42−import Text.Highlighting.Kate

4343

4444data WriterState = WriterState

4545 { stNotes :: [Html] -- ^ List of notes

@@ -293,18 +293,12 @@ blockToHtml opts (Para lst) = inlineListToHtml opts lst >>= (return . paragraph)

293293blockToHtml opts (RawHtml str) = return $ primHtml str

294294blockToHtml opts (HorizontalRule) = return $ hr

295295blockToHtml opts (CodeBlock (_,classes,_) rawCode) = do

296− let fmtOpts =

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

298− Nothing -> []

299− Just _ -> [OptNumberLines]

300− let toPre str = pre ! (if null classes then [] else [theclass $ unwords classes]) $ thecode << str

301− let lcLanguages = map (map toLower) languages

302− case find (\c -> (map toLower c) `elem` lcLanguages) classes of

303− Nothing -> return $ toPre (rawCode ++ "\n")

304− Just lang -> case highlightAs lang rawCode of

305− Left _ -> return $ toPre (rawCode ++ "\n")

306− Right hl -> do addToCSS highlightingCSS

307− return $ formatAsXHtml fmtOpts lang hl

296+ case highlightHtml classes rawCode of

297+ Left _ -> return $ pre ! (if null classes

298+ then []

299+ else [theclass $ unwords classes]) $ thecode <<

300+ (rawCode ++ "\n")

301+ Right h -> addToCSS highlightingCSS >> return h

308302blockToHtml opts (BlockQuote blocks) =

309303 -- in S5, treat list in blockquote specially

310304 -- if default is incremental, make it nonincremental;

pandoc.cabal+7−1

@@ -35,13 +35,18 @@ Description: Pandoc is a Haskell library for converting from one markup

3535Flag splitBase

3636 Description: Choose the new, smaller, split-up base package.

3737 Default: True

38+Flag highlighting

39+ Description: Compile in support for syntax highlighting of code blocks.

40+ Default: False

3841

3942Library

4043 if flag(splitBase)

4144 Build-Depends: base >= 3, pretty, containers

4245 else

4346 Build-Depends: base < 3

44− Build-Depends: parsec, xhtml, mtl, network, filepath, highlighting-kate

47+ if flag(highlighting)

48+ Build-depends: highlighting-kate

49+ Build-Depends: parsec, xhtml, mtl, network, filepath

4550 Hs-Source-Dirs: .

4651 Exposed-Modules: Text.Pandoc,

4752 Text.Pandoc.Blocks,

@@ -51,6 +56,7 @@ Library

5156 Text.Pandoc.UTF8,

5257 Text.Pandoc.ASCIIMathML,

5358 Text.Pandoc.DefaultHeaders,

59+ Text.Pandoc.Highlighting,

5460 Text.Pandoc.Readers.HTML,

5561 Text.Pandoc.Readers.LaTeX,

5662 Text.Pandoc.Readers.Markdown,

templates/Highlighting.no.hsnew file+39

@@ -0,0 +1,39 @@

1+{-

4+This program is free software; you can redistribute it and/or modify

5+it under the terms of the GNU General Public License as published by

6+the Free Software Foundation; either version 2 of the License, or

7+(at your option) any later version.

9+This program is distributed in the hope that it will be useful,

10+but WITHOUT ANY WARRANTY; without even the implied warranty of

11+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

12+GNU General Public License for more details.

13+

14+You should have received a copy of the GNU General Public License

15+along with this program; if not, write to the Free Software

16+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

17+-}

18+

19+{- |

20+ Module : Text.Pandoc.Highlighting

22+ License : GNU GPL, version 2 or above

23+

24+ Maintainer : John MacFarlane <jgm@berkeley.edu>

25+ Stability : alpha

26+ Portability : portable

27+

28+Exports functions for syntax highlighting.

29+-}

30+

31+module Text.Pandoc.Highlighting ( languages, highlightHtml ) where

32+import Text.XHtml

33+

34+languages :: [String]

35+languages = []

36+

37+highlightHtml :: [String] -> String -> Either String Html

38+highlightHtml classes str = Left "Pandoc was not compiled with support for highlighting"

39+

templates/Highlighting.yes.hsnew file+48

@@ -0,0 +1,48 @@

1+{-

4+This program is free software; you can redistribute it and/or modify

5+it under the terms of the GNU General Public License as published by

6+the Free Software Foundation; either version 2 of the License, or

7+(at your option) any later version.

9+This program is distributed in the hope that it will be useful,

10+but WITHOUT ANY WARRANTY; without even the implied warranty of

11+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

12+GNU General Public License for more details.

13+

14+You should have received a copy of the GNU General Public License

15+along with this program; if not, write to the Free Software

16+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

17+-}

18+

19+{- |

20+ Module : Text.Pandoc.Highlighting

22+ License : GNU GPL, version 2 or above

23+

24+ Maintainer : John MacFarlane <jgm@berkeley.edu>

25+ Stability : alpha

26+ Portability : portable

27+

28+Exports functions for syntax highlighting.

29+-}

30+

31+module Text.Pandoc.Highlighting ( languages, highlightHtml ) where

32+import Text.Highlighting.Kate

33+import Text.XHtml

34+import Data.List (find)

35+import Data.Char (toLower)

36+

37+highlightHtml :: [String] -> String -> Either String Html

38+highlightHtml classes rawCode =

39+ let fmtOpts = case find (`elem` ["number","numberLines","number-lines"]) classes of

40+ Nothing -> []

41+ Just _ -> [OptNumberLines]

42+ lcLanguages = map (map toLower) languages

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

44+ Nothing -> Left "Unknown or unsupported language"

45+ Just lang -> case highlightAs lang rawCode of

46+ Left err -> Left err

47+ Right hl -> Right $ formatAsXHtml fmtOpts lang hl

48+