Permalink
Browse files

Initial commit.

  • Loading branch information...
0 parents commit ede865025fbe1587d94f46a269b92fdca74fca54 jgm@berkeley.edu committed Feb 2, 2008
Showing with 46,774 additions and 0 deletions.
  1. +20 −0 Highlight.hs
  2. +340 −0 LICENSE
  3. +423 −0 ParseSyntaxFiles.hs
  4. +69 −0 README
  5. +4 −0 Setup.lhs
  6. +15 −0 Text/Highlighting/Kate.hs
  7. +228 −0 Text/Highlighting/Kate/Common.hs
  8. +64 −0 Text/Highlighting/Kate/Definitions.hs
  9. +29 −0 Text/Highlighting/Kate/Format.hs
  10. +123 −0 Text/Highlighting/Kate/Syntax.hs
  11. +133 −0 Text/Highlighting/Kate/Syntax/Ada.hs
  12. +76 −0 Text/Highlighting/Kate/Syntax/Alert.hs
  13. +288 −0 Text/Highlighting/Kate/Syntax/Asp.hs
  14. +111 −0 Text/Highlighting/Kate/Syntax/Awk.hs
  15. +649 −0 Text/Highlighting/Kate/Syntax/Bash.hs
  16. +108 −0 Text/Highlighting/Kate/Syntax/Bibtex.hs
  17. +237 −0 Text/Highlighting/Kate/Syntax/C.hs
  18. +105 −0 Text/Highlighting/Kate/Syntax/Cmake.hs
  19. +323 −0 Text/Highlighting/Kate/Syntax/Coldfusion.hs
  20. +136 −0 Text/Highlighting/Kate/Syntax/Commonlisp.hs
  21. +251 −0 Text/Highlighting/Kate/Syntax/Cpp.hs
  22. +273 −0 Text/Highlighting/Kate/Syntax/Css.hs
  23. +309 −0 Text/Highlighting/Kate/Syntax/D.hs
  24. +199 −0 Text/Highlighting/Kate/Syntax/Diff.hs
  25. +467 −0 Text/Highlighting/Kate/Syntax/Djangotemplate.hs
  26. +359 −0 Text/Highlighting/Kate/Syntax/Doxygen.hs
  27. +154 −0 Text/Highlighting/Kate/Syntax/Dtd.hs
  28. +135 −0 Text/Highlighting/Kate/Syntax/Erlang.hs
  29. +314 −0 Text/Highlighting/Kate/Syntax/Fortran.hs
  30. +137 −0 Text/Highlighting/Kate/Syntax/Haskell.hs
  31. +345 −0 Text/Highlighting/Kate/Syntax/Html.hs
  32. +214 −0 Text/Highlighting/Kate/Syntax/Java.hs
  33. +238 −0 Text/Highlighting/Kate/Syntax/Javadoc.hs
  34. +213 −0 Text/Highlighting/Kate/Syntax/Javascript.hs
  35. +143 −0 Text/Highlighting/Kate/Syntax/Json.hs
  36. +528 −0 Text/Highlighting/Kate/Syntax/Latex.hs
  37. +244 −0 Text/Highlighting/Kate/Syntax/Lex.hs
  38. +140 −0 Text/Highlighting/Kate/Syntax/LiterateHaskell.hs
  39. +178 −0 Text/Highlighting/Kate/Syntax/Lua.hs
  40. +137 −0 Text/Highlighting/Kate/Syntax/Makefile.hs
  41. +127 −0 Text/Highlighting/Kate/Syntax/Matlab.hs
  42. +207 −0 Text/Highlighting/Kate/Syntax/Mediawiki.hs
  43. +123 −0 Text/Highlighting/Kate/Syntax/Nasm.hs
  44. +157 −0 Text/Highlighting/Kate/Syntax/Objectivec.hs
  45. +276 −0 Text/Highlighting/Kate/Syntax/Objectivecpp.hs
  46. +133 −0 Text/Highlighting/Kate/Syntax/Ocaml.hs
  47. +136 −0 Text/Highlighting/Kate/Syntax/Pascal.hs
  48. +839 −0 Text/Highlighting/Kate/Syntax/Perl.hs
  49. +206 −0 Text/Highlighting/Kate/Syntax/Php.hs
  50. +101 −0 Text/Highlighting/Kate/Syntax/Postscript.hs
  51. +121 −0 Text/Highlighting/Kate/Syntax/Prolog.hs
  52. +253 −0 Text/Highlighting/Kate/Syntax/Python.hs
  53. +924 −0 Text/Highlighting/Kate/Syntax/Ruby.hs
  54. +178 −0 Text/Highlighting/Kate/Syntax/Scala.hs
  55. +195 −0 Text/Highlighting/Kate/Syntax/Scheme.hs
  56. +106 −0 Text/Highlighting/Kate/Syntax/Sgml.hs
  57. +153 −0 Text/Highlighting/Kate/Syntax/Sql.hs
  58. +174 −0 Text/Highlighting/Kate/Syntax/SqlMysql.hs
  59. +151 −0 Text/Highlighting/Kate/Syntax/SqlPostgresql.hs
  60. +130 −0 Text/Highlighting/Kate/Syntax/Tcl.hs
  61. +111 −0 Text/Highlighting/Kate/Syntax/Texinfo.hs
  62. +241 −0 Text/Highlighting/Kate/Syntax/Xml.hs
  63. +233 −0 Text/Highlighting/Kate/Syntax/Xslt.hs
  64. +243 −0 Text/Highlighting/Kate/Syntax/Yacc.hs
  65. +140 −0 highlighting-kate.cabal
  66. +196 −0 xml/ada.xml
  67. +55 −0 xml/alert.xml
  68. +393 −0 xml/asp.xml
  69. +112 −0 xml/awk.xml
  70. +885 −0 xml/bash.xml
  71. +65 −0 xml/bibtex.xml
  72. +184 −0 xml/c.xml
  73. +266 −0 xml/cmake.xml
  74. +732 −0 xml/coldfusion.xml
  75. +1,173 −0 xml/commonlisp.xml
  76. +299 −0 xml/cpp.xml
  77. +655 −0 xml/css.xml
  78. +484 −0 xml/d.xml
  79. +113 −0 xml/diff.xml
  80. +328 −0 xml/djangotemplate.xml
  81. +480 −0 xml/doxygen.xml
  82. +109 −0 xml/dtd.xml
  83. +250 −0 xml/erlang.xml
  84. +569 −0 xml/fortran.xml
  85. +392 −0 xml/haskell.xml
  86. +207 −0 xml/html.xml
  87. +3,864 −0 xml/java.xml
  88. +107 −0 xml/javadoc.xml
  89. +501 −0 xml/javascript.xml
  90. +100 −0 xml/json.xml
  91. +146 −0 xml/language.dtd
  92. +332 −0 xml/latex.xml
  93. +144 −0 xml/lex.xml
  94. +386 −0 xml/literate-haskell.xml
  95. +295 −0 xml/lua.xml
  96. +82 −0 xml/makefile.xml
  97. +222 −0 xml/matlab.xml
  98. +98 −0 xml/mediawiki.xml
  99. +888 −0 xml/nasm.xml
  100. +128 −0 xml/objectivec.xml
  101. +321 −0 xml/objectivecpp.xml
  102. +181 −0 xml/ocaml.xml
  103. +193 −0 xml/pascal.xml
  104. +827 −0 xml/perl.xml
  105. +6,572 −0 xml/php.xml
  106. +434 −0 xml/postscript.xml
  107. +230 −0 xml/prolog.xml
  108. +293 −0 xml/python.xml
  109. +873 −0 xml/ruby.xml
  110. +3,503 −0 xml/scala.xml
  111. +436 −0 xml/scheme.xml
  112. +46 −0 xml/sgml.xml
  113. +476 −0 xml/sql-mysql.xml
  114. +797 −0 xml/sql-postgresql.xml
  115. +951 −0 xml/sql.xml
  116. +536 −0 xml/tcl.xml
  117. +63 −0 xml/texinfo.xml
  118. +147 −0 xml/xml.xml
  119. +379 −0 xml/xslt.xml
  120. +159 −0 xml/yacc.xml
@@ -0,0 +1,20 @@
+module Main where
+import Text.Highlighting.Kate
+import System.IO
+import System.Environment
+import Text.XHtml.Transitional
+
+main = do
+ argv <- getArgs
+ if length argv < 2
+ then error "Usage: two arguments, language name & file name"
+ else return ()
+ let lang = argv !! 0
+ let fname = argv !! 1
+ code <- readFile fname
+ let hcode = xhtmlHighlight True lang code
+ let renderedHtml = renderHtml $ header << [thelink ! [thetype "text/css", href "css/highlighting-kate.css", rel "stylesheet"] << noHtml] +++
+ body << hcode
+ putStrLn renderedHtml
+
+
340 LICENSE

Large diffs are not rendered by default.

Oops, something went wrong.

Large diffs are not rendered by default.

Oops, something went wrong.
69 README
@@ -0,0 +1,69 @@
+highlighting-kate is a Haskell source code highlighting library, based
+on Kate's syntax description files.
+
+Currently, the following languages are supported:
+
+Ada Asp Awk Bash Bibtex
+C Cmake Coldfusion Commonlisp Cpp
+Css D Diff Djangotemplate Doxygen
+Dtd Erlang Fortran Haskell Html
+Java Javadoc Javascript Json Latex
+Lex LiterateHaskell Lua Makefile Matlab
+Mediawiki Nasm Objectivec Objectivecpp Ocaml
+Pascal Perl Php Postscript Prolog
+Python Ruby Scala Scheme Sgml
+Sql SqlMysql SqlPostgresql Tcl Texinfo
+Xml Xslt Yacc
+
+To install:
+
+ runghc Setup.lhs configure
+ runghc Setup.lhs build
+ runghc Setup.lhs install
+
+The last command must be run as root, or --user may be specified to install
+the library into the user package database.
+
+For an example of the use of the library, see Highlight.hs.
+After installing the library using the steps above, you can compile
+this program with the following command:
+
+ ghc Highlight.hs -package highlighting-kate -o Highlight
+
+To run Highlight, provide two arguments, the language name and the
+file to be highligted. For example,
+
+ ./Highlight haskell Highlight.hs > example.html
+
+will highlight Highlight.hs and put the result in example.html.
+
+Styling is done using span tags, so text will not appear any different
+unless an appropriate CSS file is used. There are two CSS files in
+the css directory. These use generic class names; for more fine-grained
+highlighting, users may wish to create their own CSS files that use
+language-specific classes.
+
+The parsers in Text/Highlighting/Kate/Syntax were automatically generated
+from the Kate syntax definitions in the xml directory. (Note that in a
+few cases, the xml files have been modified; the original has been left
+with a .orig suffix.) You may modify the xml files in this directory,
+or add new ones, and then regenerate the parsers by doing:
+
+ runghc ParseSyntaxFiles.hs xml
+
+Note that ParseSyntaxFiles.hs requires the HXT package.
+
+You can browse the available Kate syntax highlighting files at
+
+ http://kate-editor.org/downloads/syntax_highlighting
+
+or retrieve them all using Subversion:
+
+ svn co svn://anonsvn.kde.org/home/kde/trunk/KDE/kdelibs/kate/syntax/data kate-data
+
+There is information on the syntax highlighting definitions at
+
+ http://kate-editor.org/article/writing_a_kate_highlighting_xml_file
+
+Thanks are due to all the authors of these syntax definitions!
+
@@ -0,0 +1,4 @@
+#!/usr/bin/env runhaskell
+
+> import Distribution.Simple
+> main = defaultMain
@@ -0,0 +1,15 @@
+module Text.Highlighting.Kate ( highlight, xhtmlHighlight ) where
+import Text.Highlighting.Kate.Format ( formatAsXHtml )
+import Text.Highlighting.Kate.Syntax ( highlight )
+import Text.XHtml.Transitional
+
+-- | Highlight source code in XHTML using specified syntax.
+xhtmlHighlight :: Bool -- ^ Number lines
+ -> String -- ^ Name of syntax to use
+ -> String -- ^ Source code to highlight
+ -> Html
+xhtmlHighlight numberLines lang code =
+ case highlight lang code of
+ Right result -> formatAsXHtml numberLines lang result
+ Left _ -> pre $ thecode << code
+
@@ -0,0 +1,228 @@
+module Text.Highlighting.Kate.Common where
+import Text.Regex.PCRE.Light.Char8
+import Text.Highlighting.Kate.Definitions
+import Text.ParserCombinators.Parsec
+import Data.Char (toUpper, isDigit, chr)
+import qualified Data.Map as Map
+
+-- | Like >>, but returns the operation on the left.
+-- (Suggested by Tillmann Rendel on Haskell-cafe list.)
+(>>~) :: (Monad m) => m a -> m b -> m a
+a >>~ b = a >>= \x -> b >> return x
+
+capitalize [] = []
+capitalize (a:as) = toUpper a : as
+
+normalizeHighlighting :: [LabeledSource] -> [LabeledSource]
+normalizeHighlighting [] = []
+normalizeHighlighting ((_,""):xs) = normalizeHighlighting xs
+normalizeHighlighting ((a,x):(b,y):xs) | a == b = normalizeHighlighting ((a, x++y):xs)
+normalizeHighlighting (x:xs) = x : normalizeHighlighting xs
+
+pushContext context = do st <- getState
+ if context == "#stay"
+ then return ()
+ else let contexts = synStContexts st
+ lang = synStLanguage st
+ addContext c x = case x of
+ Nothing -> Just [c]
+ Just cs -> Just (c:cs)
+ newContexts = Map.alter (addContext context) lang contexts
+ in updateState $ \st -> st { synStContexts = newContexts }
+
+popContext = do st <- getState
+ let contexts = synStContexts st
+ let lang = synStLanguage st
+ case Map.lookup lang contexts of
+ Just conts -> case length conts of
+ 0 -> fail $ "Stack empty for language " ++ lang
+ 1 -> return (head conts) -- don't remove last member of stack
+ _ -> do let newContexts = Map.adjust tail lang contexts
+ updateState $ \st -> st { synStContexts = newContexts }
+ return (head conts)
+ Nothing -> fail $ "No context stack for language " ++ lang
+
+currentContext = do st <- getState
+ let contexts = synStContexts st
+ let lang = synStLanguage st
+ case Map.lookup lang contexts of
+ Just conts -> if length conts < 1
+ then fail $ "Stack empty for language " ++ lang
+ else return (head conts)
+ Nothing -> fail $ "No context stack for language " ++ lang
+
+withChildren parent child = do
+ (pAttr, pResult) <- parent
+ (_, cResult) <- option ([],"") child
+ return (pAttr, pResult ++ cResult)
+
+wholeLine = manyTill anyChar (newline <|> (eof >> return '\n'))
+
+pFirstNonSpace = do
+ curLine <- currentLine
+ charsParsedInLine <- getState >>= return . synStCharsParsedInLine
+ let (sps, nonSps) = span (`elem` " \t") curLine
+ if length sps == charsParsedInLine && length nonSps > 0
+ then return ()
+ else fail "Not first nonspace"
+
+nonSpaceChar ch = not (ch `elem` " \t")
+
+currentColumn = getPosition >>= return . sourceColumn
+
+currentLine = getState >>= return . synStCurrentLine
+
+pChar ch = char ch
+
+pColumn col = do
+ curCol <- currentColumn
+ if col == (curCol - 1) -- parsec's columns start with 1
+ then return ()
+ else fail $ "Not column " ++ show col
+
+pGetCapture capNum = do
+ captures <- getState >>= return . synStCaptures
+ if length captures < capNum
+ then fail "Not enough captures"
+ else return $ captures !! (capNum - 1)
+
+pDetectChar dynamic ch = do
+ if dynamic && isDigit ch
+ then pGetCapture (read [ch]) >>= try . string
+ else pChar ch >>= return . (:[])
+
+pDetect2Chars dynamic ch1 ch2 = try $ do
+ [c1] <- pDetectChar dynamic ch1
+ [c2] <- pDetectChar dynamic ch2
+ return [c1, c2]
+
+prevCharacter = do
+ st <- getState
+ let ln = synStCurrentLine st
+ let charsParsed = synStCharsParsedInLine st
+ if charsParsed == 0
+ then return Nothing
+ else if length ln < charsParsed
+ then fail $ "Line shorter than number of characters parsed"
+ else return $ Just $ ln !! (charsParsed - 1)
+
+pKeyword list = try $ do
+ st <- getState
+ let caseSensitive = synStKeywordCaseSensitive st
+ let delims = synStKeywordDelims st
+ prevChar <- prevCharacter
+ case prevChar of
+ Just x | x `elem` delims -> return ()
+ Nothing -> return ()
+ _ -> fail "Not preceded by a delimiter"
+ word <- many1 (noneOf delims)
+ if word `elem` list
+ then return word
+ else if not caseSensitive && (map toUpper word) `elem` (map (map toUpper) list)
+ then return word
+ else fail "Keyword not in list"
+
+pString dynamic str = do
+ if dynamic
+ then subDynamic str >>= try . string
+ else try $ string str
+
+pAnyChar chars = oneOf chars >>= return . (:[])
+
+pDefault = noneOf "\n" >>= return . (:[])
+
+subDynamic ('%':x:xs) | isDigit x = do
+ captures <- getState >>= return . synStCaptures
+ let capNum = read [x]
+ let replacement = if length captures < capNum
+ then ['%',x]
+ else captures !! (capNum - 1)
+ subDynamic xs >>= return . (replacement ++)
+subDynamic (x:xs) = subDynamic xs >>= return . (x:)
+subDynamic "" = return ""
+
+pRegExpr compiledRegex = do
+ st <- getState
+ let curLine = synStCurrentLine st
+ let charsParsedInLine = synStCharsParsedInLine st
+ -- Note: we keep one preceding character, so initial \b can match or not...
+ let remaining = if charsParsedInLine == 0
+ then ' ':curLine
+ else drop (charsParsedInLine - 1) curLine
+ case match compiledRegex remaining [] of
+ Just (x:xs) -> do if null xs
+ then return ()
+ else updateState (\st -> st {synStCaptures = xs})
+ string (drop 1 x)
+ _ -> fail $ "Regex " ++ (show compiledRegex) ++ " failed to match"
+
+pRegExprDynamic regexpStr = do
+ regexpStr' <- subDynamic regexpStr
+ let compiledRegex = compileRegex regexpStr'
+ pRegExpr compiledRegex
+
+escapeRegex :: String -> String
+escapeRegex [] = ""
+escapeRegex ('\\':'0':x:y:z:rest) | isDigit x && isDigit y && isDigit z =
+ chr (read ['0','o',x,y,z]) : escapeRegex rest
+escapeRegex ('\\':x:y:z:rest) | isDigit x && isDigit y && isDigit z =
+ chr (read ['0','o',x,y,z]) : escapeRegex rest
+escapeRegex (x:xs) = x : escapeRegex xs
+
+compileRegex regexpStr =
+ let regexpStr' = escapeRegex regexpStr
+ in compile ('^':'.':regexpStr') []
+
+integerRegex = compileRegex "\\b[-+]?(0[Xx][0-9A-Fa-f]+|0[Oo][0-7]+|[0-9]+)\\b"
+
+pInt = pRegExpr integerRegex
+
+pUnimplemented :: GenParser Char st [Char]
+pUnimplemented = do
+ fail "Not implemented"
+ return ""
+
+floatRegex = compileRegex "\\b[-+]?(([0-9]+\\.[0-9]*|[0-9]*\\.[0-9]+)([Ee][-+]?[0-9]+)?|[0-9]+[Ee][-+]?[0-9]+)\\b"
+
+pFloat = pRegExpr floatRegex
+
+octRegex = compileRegex "\\b[-+]?0[Oo][0-7]+\\b"
+
+pHlCOct = pRegExpr octRegex
+
+hexRegex = compileRegex "\\b[-+]?0[Xx][0-9A-Fa-f]+\\b"
+
+pHlCHex = pRegExpr hexRegex
+
+pHlCStringChar = try $ do
+ char '\\'
+ (oneOf "abefnrtv\"'?\\" >>= return . (\x -> ['\\',x]))
+ <|> (do a <- oneOf "xX"
+ b <- many1 hexDigit
+ return ('\\':a:b))
+ <|> (do a <- char '0'
+ b <- many1 octDigit
+ return ('\\':a:b))
+
+pHlCChar = try $ do
+ char '\''
+ c <- pHlCStringChar
+ char '\''
+ return ('\'' : c ++ "'")
+
+pRangeDetect startChar endChar = try $ do
+ char startChar
+ body <- manyTill (noneOf ['\n', endChar]) (char endChar)
+ return $ startChar : (body ++ [endChar])
+
+pLineContinue = try $ string "\\\n"
+
+pIncludeRules = pUnimplemented -- or, handle at level of parsing xml?
+
+pDetectSpaces = many1 (oneOf "\t ")
+
+pDetectIdentifier = do
+ first <- letter
+ rest <- many alphaNum
+ return (first:rest)
+
Oops, something went wrong.

0 comments on commit ede8650

Please sign in to comment.