{- This module was generated from data in the Kate syntax
   highlighting file postscript.xml, version 1.01, by  -}

module Text.Highlighting.Kate.Syntax.Postscript
          (highlight, parseExpression, syntaxName, syntaxExtensions)
where
import Text.Highlighting.Kate.Types
import Text.Highlighting.Kate.Common
import Text.ParserCombinators.Parsec hiding (State)
import Control.Monad.State
import Data.Char (isSpace)
import qualified Data.Set as Set

-- | Full name of language.
syntaxName :: String
syntaxName = "PostScript"

-- | Filename extensions for this language.
syntaxExtensions :: String
syntaxExtensions = "*.ps;*.ai;*.eps"

-- | Highlight source code using this syntax definition.
highlight :: String -> [SourceLine]
highlight input = evalState (mapM parseSourceLine $ lines input) startingState

parseSourceLine :: String -> State SyntaxState SourceLine
parseSourceLine = mkParseSourceLine (parseExpression Nothing)

-- | Parse an expression using appropriate local context.
parseExpression :: Maybe (String,String)
                -> KateParser Token
parseExpression mbcontext = do
  (lang,cont) <- maybe currentContext return mbcontext
  result <- parseRules (lang,cont)
  optional $ do eof
                updateState $ \st -> st{ synStPrevChar = '\n' }
                pEndLine
  return result

startingState = SyntaxState {synStContexts = [("PostScript","Normal")], synStLineNumber = 0, synStPrevChar = '\n', synStPrevNonspace = False, synStCaseSensitive = True, synStKeywordCaseSensitive = False, synStCaptures = []}

pEndLine = do
  updateState $ \st -> st{ synStPrevNonspace = False }
  context <- currentContext
  contexts <- synStContexts `fmap` getState
  if length contexts >= 2
    then case context of
      ("PostScript","Normal") -> return ()
      ("PostScript","Comment") -> (popContext) >> pEndLine
      ("PostScript","Header") -> (popContext) >> pEndLine
      ("PostScript","String") -> return ()
      _ -> return ()
    else return ()

withAttribute attr txt = do
  when (null txt) $ fail "Parser matched no text"
  updateState $ \st -> st { synStPrevChar = last txt
                          , synStPrevNonspace = synStPrevNonspace st || not (all isSpace txt) }
  return (attr, txt)

list_keywords = Set.fromList $ words $ "abs add aload anchorsearch and arc arcn arct arcto array ashow astore awidthshow begin bind bitshift ceiling charpath clear cleartomark clip clippath closepath concat concatmatrix copy count counttomark currentcmykcolor currentdash currentdict currentfile currentfont currentgray currentgstate currenthsbcolor currentlinecap currentlinejoin currentlinewidth currentmatrix currentpoint currentrgbcolor currentshared curveto cvi cvlit cvn cvr cvrs cvs cvx def defineusername dict div dtransform dup end eoclip eofill eoviewclip eq exch exec exit file fill findfont flattenpath floor flush flushfile for forall ge get getinterval grestore gsave gstate gt identmatrix idiv idtransform if ifelse image imagemask index ineofill infill initviewclip inueofill inufill invertmatrix itransform known le length lineto load loop lt makefont matrix maxlength mod moveto mul ne neg newpath not null or pathbbox pathforall pop print printobject put putinterval rcurveto read readhexstring readline readstring rectclip rectfill rectstroke rectviewclip repeat restore rlineto rmoveto roll rotate round save scale scalefont search selectfont setbbox setcachedevice setcachedevice2 setcharwidth setcmykcolor setdash setfont setgray setgstate sethsbcolor setlinecap setlinejoin setlinewidth setmatrix setrgbcolor setshared shareddict show showpage stop stopped store string stringwidth stroke strokepath sub systemdict token transform translate truncate type uappend ucache ueofill ufill undef upath userdict ustroke viewclip viewclippath where widthshow write writehexstring writeobject writestring wtranslation xor xshow xyshow yshow fontdirectory sharedfontdirectory courier courier-bold courier-boldoblique courier-oblique helvetica helvetica-bold helvetica-boldoblique helvetica-oblique symbol times-bold times-bolditalic times-italic times-roman execuserobject currentcolor currentcolorspace currentglobal execform filter findresource globaldict makepattern setcolor setcolorspace setglobal setpagedevice setpattern isolatin1encoding standardencoding atan banddevice bytesavailable cachestatus closefile colorimage condition copypage cos countdictstack countexecstack cshow currentblackgeneration currentcacheparams currentcolorscreen currentcolortransfer currentcontext currentflat currenthalftone currenthalftonephase currentmiterlimit currentobjectformat currentpacking currentscreen currentstrokeadjust currenttransfer currentundercolorremoval defaultmatrix definefont deletefile detach deviceinfo dictstack echo erasepage errordict execstack executeonly exp false filenameforall fileposition fork framedevice grestoreall handleerror initclip initgraphics initmatrix instroke inustroke join kshow ln lock log mark monitor noaccess notify nulldevice packedarray quit rand rcheck readonly realtime renamefile renderbands resetfile reversepath rootfont rrand run scheck setblackgeneration setcachelimit setcacheparams setcolorscreen setcolortransfer setfileposition setflat sethalftone sethalftonephase setmiterlimit setobjectformat setpacking setscreen setstrokeadjust settransfer setucacheparams setundercolorremoval sin sqrt srand stack status statusdict true ucachestatus undefinefont usertime ustrokepath version vmreclaim vmstatus wait wcheck xcheck yield defineuserobject undefineuserobject userobjects cleardictstack setvmthreshold currentcolorrendering currentdevparams currentoverprint currentpagedevice currentsystemparams currentuserparams defineresource findencoding gcheck glyphshow languagelevel product pstack resourceforall resourcestatus revision serialnumber setcolorrendering setdevparams setoverprint setsystemparams setuserparams startjob undefineresource globalfontdirectory ascii85decode ascii85encode asciihexdecode asciihexencode ccittfaxdecode ccittfaxencode dctdecode dctencode lzwdecode lzwencode nullencode runlengthdecode runlengthencode subfiledecode ciebaseda ciebasedabc devicecmyk devicegray devicergb indexed pattern separation ciebaseddef ciebaseddefg devicen"

regex_'5c'2f'7b1'2c2'7d'5b'5e'5cs'5c'28'5c'29'5c'7b'5c'7d'5c'5b'5c'5d'25'2f'5d'2a = compileRegex True "\\/{1,2}[^\\s\\(\\)\\{\\}\\[\\]%/]*"

parseRules ("PostScript","Normal") =
  (((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_keywords >>= withAttribute KeywordTok))
   <|>
   ((pDetect2Chars False '%' '!' >>= withAttribute OtherTok) >>~ pushContext ("PostScript","Header"))
   <|>
   ((pDetectChar False '%' >>= withAttribute CommentTok) >>~ pushContext ("PostScript","Comment"))
   <|>
   ((pFloat >>= withAttribute FloatTok))
   <|>
   ((pInt >>= withAttribute DecValTok))
   <|>
   ((pDetectChar False '(' >>= withAttribute StringTok) >>~ pushContext ("PostScript","String"))
   <|>
   ((pRegExpr regex_'5c'2f'7b1'2c2'7d'5b'5e'5cs'5c'28'5c'29'5c'7b'5c'7d'5c'5b'5c'5d'25'2f'5d'2a >>= withAttribute DataTypeTok))
   <|>
   (currentContext >>= \x -> guard (x == ("PostScript","Normal")) >> pDefault >>= withAttribute NormalTok))

parseRules ("PostScript","Comment") =
  (currentContext >>= \x -> guard (x == ("PostScript","Comment")) >> pDefault >>= withAttribute CommentTok)

parseRules ("PostScript","Header") =
  (currentContext >>= \x -> guard (x == ("PostScript","Header")) >> pDefault >>= withAttribute OtherTok)

parseRules ("PostScript","String") =
  (((pDetectChar False ')' >>= withAttribute StringTok) >>~ (popContext))
   <|>
   (currentContext >>= \x -> guard (x == ("PostScript","String")) >> pDefault >>= withAttribute StringTok))


parseRules x = parseRules ("PostScript","Normal") <|> fail ("Unknown context" ++ show x)