diff options
| -rw-r--r-- | Main.hs | 8 | ||||
| -rw-r--r-- | Setup.hs | 11 | ||||
| -rw-r--r-- | Text/Pandoc/Writers/HTML.hs | 20 | ||||
| -rw-r--r-- | pandoc.cabal | 8 | ||||
| -rw-r--r-- | templates/Highlighting.no.hs | 39 | ||||
| -rw-r--r-- | templates/Highlighting.yes.hs | 48 |
6 files changed, 118 insertions, 16 deletions
@@ -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" @@ -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 + |