From 04b32451be96cc64e3c8ee37a4b099ffe6236146 Mon Sep 17 00:00:00 2001
From: fiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>
Date: Sat, 9 Feb 2008 03:21:19 +0000
Subject: [PATCH] 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 | 8 +++++-
Setup.hs | 11 +++++++-
Text/Pandoc/Writers/HTML.hs | 20 +++++----------
pandoc.cabal | 8 +++++-
templates/Highlighting.no.hs | 39 ++++++++++++++++++++++++++++
templates/Highlighting.yes.hs | 48 +++++++++++++++++++++++++++++++++++
6 files changed, 118 insertions(+), 16 deletions(-)
create mode 100644 templates/Highlighting.no.hs
create mode 100644 templates/Highlighting.yes.hs
diff --git a/Main.hs b/Main.hs
index e25b0b1ad..5f198b349 100644
--- a/Main.hs
+++ b/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"
diff --git a/Setup.hs b/Setup.hs
index 977b6494e..d402b4954 100644
--- a/Setup.hs
+++ b/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.
diff --git a/Text/Pandoc/Writers/HTML.hs b/Text/Pandoc/Writers/HTML.hs
index 7837493a1..e668e9885 100644
--- a/Text/Pandoc/Writers/HTML.hs
+++ b/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;
diff --git a/pandoc.cabal b/pandoc.cabal
index a5c76ee51..78d8794a5 100644
--- a/pandoc.cabal
+++ b/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,
diff --git a/templates/Highlighting.no.hs b/templates/Highlighting.no.hs
new file mode 100644
index 000000000..2acea4420
--- /dev/null
+++ b/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"
+
diff --git a/templates/Highlighting.yes.hs b/templates/Highlighting.yes.hs
new file mode 100644
index 000000000..a015e1e34
--- /dev/null
+++ b/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
+