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

Main.hs

@@ -32,6 +32,7 @@ module Main where
 import Text.Pandoc
 import Text.Pandoc.UTF8
 import Text.Pandoc.Shared ( joinWithSep, HTMLMathMethod (..) )
+import Text.Pandoc.Highlighting ( languages )
 import System.Environment ( getArgs, getProgName, getEnvironment )
 import System.Exit ( exitWith, ExitCode (..) )
 import System.FilePath ( takeExtension )
@@ -47,6 +48,11 @@ copyrightMessage = "\nCopyright (C) 2006-7 John MacFarlane\n\
                     \This is free software; see the source for copying conditions.  There is no\n\
                     \warranty, not even for merchantability or fitness for a particular purpose."
 
+compileOptions :: String
+compileOptions = if null languages
+                    then " [compiled without syntax highlighting support]"
+                    else " [compiled with syntax highlighting support]" 
+
 -- | Association list of formats and readers.
 readers :: [(String, ParserState -> String -> Pandoc)]
 readers = [("native"   , readPandoc)
@@ -315,7 +321,7 @@ options =
                  (NoArg
                   (\_ -> do
                      prg <- getProgName
-                     hPutStrLn stderr (prg ++ " " ++ pandocVersion ++ 
+                     hPutStrLn stderr (prg ++ " " ++ pandocVersion ++ compileOptions ++
                                        copyrightMessage)
                      exitWith $ ExitFailure 4))
                  "" -- "Print version"

Setup.hs

@@ -3,7 +3,7 @@ import Distribution.Simple.Setup
 import Distribution.PackageDescription
 import Distribution.Simple.LocalBuildInfo
 import System.FilePath (combine, joinPath, takeFileName)
-import System.Directory (getDirectoryContents, removeFile)
+import System.Directory (getDirectoryContents, removeFile, copyFile)
 import System.IO (readFile, writeFile)
 import Control.Monad (foldM)
 import Data.List (isPrefixOf)
@@ -22,6 +22,14 @@ myPostConf _ configFlags pkgDescription buildInfo = do
   fillAsciiMathMLTemplate
   fillS5WriterTemplate
   fillDefaultHeadersTemplate
+  let deps = packageDeps buildInfo
+  let highlighting = any (\id -> pkgName id == "highlighting-kate") deps 
+  let highlightingModule = if highlighting
+                              then combine "templates" "Highlighting.yes.hs"
+                              else combine "templates" "Highlighting.no.hs"
+  copyFile highlightingModule $ joinPath ["Text", "Pandoc", "Highlighting.hs"] 
+  putStrLn $ "  Text/Pandoc/Highlighting.hs [" ++ 
+             (if highlighting then "with" else "without") ++ " syntax highlighting support]"
 
 -- Fill templateFile with data in dataFiles and write to outputFile.
 fillTemplate :: [FilePath] -> FilePath -> FilePath -> IO ()
@@ -53,6 +61,7 @@ myPostClean _ _ _ _ = do
   putStrLn "Removing source files generated from templates:"
   removeGeneratedFile $ joinPath [pandocPath, "ASCIIMathML.hs"]
   removeGeneratedFile $ joinPath [pandocPath, "DefaultHeaders.hs"]
+  removeGeneratedFile $ joinPath [pandocPath, "Highlighting.hs"]
   removeGeneratedFile $ joinPath [pandocPath, "Writers", "S5.hs"]
 
 -- Remove file and print message.

Text/Pandoc/Writers/HTML.hs

@@ -33,13 +33,13 @@ import Text.Pandoc.ASCIIMathML
 import Text.Pandoc.CharacterReferences ( decodeCharacterReferences )
 import Text.Pandoc.Shared
 import Text.Pandoc.Readers.TeXMath
+import Text.Pandoc.Highlighting ( highlightHtml )
 import Numeric ( showHex )
 import Data.Char ( ord, toLower, isAlpha )
 import Data.List ( isPrefixOf, intersperse, find )
 import qualified Data.Set as S
 import Control.Monad.State
 import Text.XHtml.Transitional
-import Text.Highlighting.Kate
 
 data WriterState = WriterState
     { stNotes            :: [Html]       -- ^ List of notes
@@ -293,18 +293,12 @@ blockToHtml opts (Para lst) = inlineListToHtml opts lst >>= (return . paragraph)
 blockToHtml opts (RawHtml str) = return $ primHtml str
 blockToHtml opts (HorizontalRule) = return $ hr
 blockToHtml opts (CodeBlock (_,classes,_) rawCode) = do
-  let fmtOpts = 
-        case find (`elem` ["number","numberLines","number-lines"]) classes of
-              Nothing   -> []
-              Just _    -> [OptNumberLines]
-  let toPre str = pre ! (if null classes then [] else [theclass $ unwords classes]) $ thecode << str 
-  let lcLanguages = map (map toLower) languages
-  case find (\c -> (map toLower c) `elem` lcLanguages) classes of
-        Nothing   -> return $ toPre (rawCode ++ "\n")
-        Just lang -> case highlightAs lang rawCode of
-                           Left _   -> return $ toPre (rawCode ++ "\n")
-                           Right hl -> do addToCSS highlightingCSS 
-                                          return $ formatAsXHtml fmtOpts lang hl
+  case highlightHtml classes rawCode of
+         Left _  -> return $ pre ! (if null classes
+                                       then []
+                                       else [theclass $ unwords classes]) $ thecode << 
+                                            (rawCode ++ "\n")
+         Right h -> addToCSS highlightingCSS >> return h
 blockToHtml opts (BlockQuote blocks) =
   -- in S5, treat list in blockquote specially
   -- if default is incremental, make it nonincremental; 

pandoc.cabal

@@ -35,13 +35,18 @@ Description:     Pandoc is a Haskell library for converting from one markup
 Flag splitBase
   Description:   Choose the new, smaller, split-up base package.
   Default:       True
+Flag highlighting
+  Description:   Compile in support for syntax highlighting of code blocks.
+  Default:       False
 
 Library
   if flag(splitBase)
     Build-Depends: base >= 3, pretty, containers
   else
     Build-Depends: base < 3
-  Build-Depends: parsec, xhtml, mtl, network, filepath, highlighting-kate
+  if flag(highlighting)
+    Build-depends: highlighting-kate
+  Build-Depends: parsec, xhtml, mtl, network, filepath
   Hs-Source-Dirs:  .
   Exposed-Modules: Text.Pandoc,
                    Text.Pandoc.Blocks,
@@ -51,6 +56,7 @@ Library
                    Text.Pandoc.UTF8,
                    Text.Pandoc.ASCIIMathML,
                    Text.Pandoc.DefaultHeaders,
+                   Text.Pandoc.Highlighting,
                    Text.Pandoc.Readers.HTML,
                    Text.Pandoc.Readers.LaTeX,
                    Text.Pandoc.Readers.Markdown,

templates/Highlighting.no.hs

@@ -0,0 +1,39 @@
+{-
+Copyright (C) 2008 John MacFarlane <jgm@berkeley.edu>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+-}
+
+{- |
+   Module      : Text.Pandoc.Highlighting
+   Copyright   : Copyright (C) 2008 John MacFarlane
+   License     : GNU GPL, version 2 or above 
+
+   Maintainer  : John MacFarlane <jgm@berkeley.edu>
+   Stability   : alpha
+   Portability : portable
+
+Exports functions for syntax highlighting.
+-}
+
+module Text.Pandoc.Highlighting ( languages, highlightHtml ) where
+import Text.XHtml
+
+languages :: [String]
+languages = []
+
+highlightHtml :: [String] -> String -> Either String Html
+highlightHtml classes str = Left "Pandoc was not compiled with support for highlighting"
+

templates/Highlighting.yes.hs

@@ -0,0 +1,48 @@
+{-
+Copyright (C) 2008 John MacFarlane <jgm@berkeley.edu>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+-}
+
+{- |
+   Module      : Text.Pandoc.Highlighting
+   Copyright   : Copyright (C) 2008 John MacFarlane
+   License     : GNU GPL, version 2 or above 
+
+   Maintainer  : John MacFarlane <jgm@berkeley.edu>
+   Stability   : alpha
+   Portability : portable
+
+Exports functions for syntax highlighting.
+-}
+
+module Text.Pandoc.Highlighting ( languages, highlightHtml ) where
+import Text.Highlighting.Kate
+import Text.XHtml
+import Data.List (find)
+import Data.Char (toLower)
+
+highlightHtml :: [String] -> String -> Either String Html
+highlightHtml classes rawCode =
+  let fmtOpts = case find (`elem` ["number","numberLines","number-lines"]) classes of
+                  Nothing   -> []
+                  Just _    -> [OptNumberLines]
+      lcLanguages = map (map toLower) languages
+  in  case find (\c -> (map toLower c) `elem` lcLanguages) classes of
+            Nothing   -> Left "Unknown or unsupported language"
+            Just lang -> case highlightAs lang rawCode of
+                               Left err -> Left err
+                               Right hl -> Right $ formatAsXHtml fmtOpts lang hl
+