yi-misc-modes-0.18.0/src/0000755000000000000000000000000013226661437013246 5ustar0000000000000000yi-misc-modes-0.18.0/src/Yi/0000755000000000000000000000000013326314040013611 5ustar0000000000000000yi-misc-modes-0.18.0/src/Yi/Config/0000755000000000000000000000000013226661437015034 5ustar0000000000000000yi-misc-modes-0.18.0/src/Yi/Config/Default/0000755000000000000000000000000013326314040016402 5ustar0000000000000000yi-misc-modes-0.18.0/src/Yi/Lexer/0000755000000000000000000000000013326314040014670 5ustar0000000000000000yi-misc-modes-0.18.0/src/Yi/Mode/0000755000000000000000000000000013246767342014517 5ustar0000000000000000yi-misc-modes-0.18.0/src/Yi/Syntax/0000755000000000000000000000000013226661437015115 5ustar0000000000000000yi-misc-modes-0.18.0/src/Yi/Config/Default/MiscModes.hs0000644000000000000000000000100213326314040020612 0ustar0000000000000000module Yi.Config.Default.MiscModes (configureMiscModes) where import Yi.Config.Simple (ConfigM, addMode) import Yi.Modes configureMiscModes :: ConfigM () configureMiscModes = do addMode cMode addMode objectiveCMode addMode cppMode addMode cabalMode addMode clojureMode addMode srmcMode addMode gitCommitMode addMode svnCommitMode addMode ocamlMode addMode perlMode addMode rubyMode addMode pythonMode addMode jsonMode addMode gnuMakeMode addMode ottMode addMode whitespaceMode yi-misc-modes-0.18.0/src/Yi/Modes.hs0000644000000000000000000001234013326314040015214 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Modes -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Definitions for the bulk of modes shipped with Yi. module Yi.Modes (cMode, objectiveCMode, cppMode, cabalMode, clojureMode, srmcMode, ocamlMode, ottMode, gnuMakeMode, perlMode, pythonMode, javaMode, jsonMode, anyExtension, svnCommitMode, whitespaceMode, gitCommitMode, rubyMode ) where import Lens.Micro.Platform ((%~), (&), (.~)) import Data.List (isPrefixOf) import System.FilePath (takeDirectory, takeFileName) import Yi.Buffer --import Yi.Lexer.Alex import qualified Yi.Lexer.C as C (lexer) import qualified Yi.Lexer.Cabal as Cabal (lexer) import qualified Yi.Lexer.Clojure as Clojure (lexer) import qualified Yi.Lexer.Cplusplus as Cplusplus (lexer) import qualified Yi.Lexer.GitCommit as GitCommit (Token, lexer) import qualified Yi.Lexer.GNUMake as GNUMake (lexer) import qualified Yi.Lexer.Java as Java (lexer) import qualified Yi.Lexer.JSON as JSON (lexer) import qualified Yi.Lexer.ObjectiveC as ObjectiveC (lexer) import qualified Yi.Lexer.OCaml as OCaml (Token, lexer) import qualified Yi.Lexer.Ott as Ott (lexer) import qualified Yi.Lexer.Perl as Perl (lexer) import qualified Yi.Lexer.Python as Python (lexer) import qualified Yi.Lexer.Ruby as Ruby (lexer) import qualified Yi.Lexer.Srmc as Srmc (lexer) import qualified Yi.Lexer.SVNCommit as SVNCommit (lexer) import qualified Yi.Lexer.Whitespace as Whitespace (lexer) import Yi.Mode.Common import Yi.Style (StyleName) cMode :: TokenBasedMode StyleName cMode = styleMode C.lexer & modeNameA .~ "c" & modeAppliesA .~ anyExtension [ "c", "h" ] objectiveCMode :: TokenBasedMode StyleName objectiveCMode = styleMode ObjectiveC.lexer & modeNameA .~ "objective-c" & modeAppliesA .~ anyExtension [ "m", "mm" ] cppMode :: TokenBasedMode StyleName cppMode = styleMode Cplusplus.lexer & modeAppliesA .~ anyExtension [ "cxx", "cpp", "hxx" ] & modeNameA .~ "c++" cabalMode :: TokenBasedMode StyleName cabalMode = styleMode Cabal.lexer & modeNameA .~ "cabal" & modeAppliesA .~ anyExtension [ "cabal" ] & modeToggleCommentSelectionA .~ Just (toggleCommentB "--") clojureMode :: TokenBasedMode StyleName clojureMode = styleMode Clojure.lexer & modeNameA .~ "clojure" & modeAppliesA .~ anyExtension [ "clj", "edn" ] srmcMode :: TokenBasedMode StyleName srmcMode = styleMode Srmc.lexer & modeNameA .~ "srmc" & modeAppliesA .~ anyExtension [ "pepa", "srmc" ] -- pepa is a subset of srmc gitCommitMode :: TokenBasedMode GitCommit.Token gitCommitMode = styleMode GitCommit.lexer & modeNameA .~ "git-commit" & modeAppliesA .~ isCommit where isCommit p _ = case (takeFileName p, takeFileName $ takeDirectory p) of ("COMMIT_EDITMSG", ".git") -> True _ -> False svnCommitMode :: TokenBasedMode StyleName svnCommitMode = styleMode SVNCommit.lexer & modeNameA .~ "svn-commit" & modeAppliesA .~ isCommit where isCommit p _ = "svn-commit" `isPrefixOf` p && extensionMatches ["tmp"] p ocamlMode :: TokenBasedMode OCaml.Token ocamlMode = styleMode OCaml.lexer & modeNameA .~ "ocaml" & modeAppliesA .~ anyExtension [ "ml", "mli", "mly" , "mll", "ml4", "mlp4" ] perlMode :: TokenBasedMode StyleName perlMode = styleMode Perl.lexer & modeNameA .~ "perl" & modeAppliesA .~ anyExtension [ "t", "pl", "pm" ] rubyMode :: TokenBasedMode StyleName rubyMode = styleMode Ruby.lexer & modeNameA .~ "ruby" & modeAppliesA .~ anyExtension [ "rb", "ru" ] pythonMode :: TokenBasedMode StyleName pythonMode = base & modeNameA .~ "python" & modeAppliesA .~ anyExtension [ "py" ] & modeToggleCommentSelectionA .~ Just (toggleCommentB "#") & modeIndentSettingsA %~ (\x -> x { expandTabs = True, tabSize = 4 }) where base = styleMode Python.lexer javaMode :: TokenBasedMode StyleName javaMode = styleMode Java.lexer & modeNameA .~ "java" & modeAppliesA .~ anyExtension [ "java" ] jsonMode :: TokenBasedMode StyleName jsonMode = styleMode JSON.lexer & modeNameA .~ "json" & modeAppliesA .~ anyExtension [ "json" ] gnuMakeMode :: TokenBasedMode StyleName gnuMakeMode = styleMode GNUMake.lexer & modeNameA .~ "Makefile" & modeAppliesA .~ isMakefile & modeIndentSettingsA %~ (\x -> x { expandTabs = False, shiftWidth = 8 }) where isMakefile :: FilePath -> a -> Bool isMakefile path _contents = matches $ takeFileName path where matches "Makefile" = True matches "makefile" = True matches "GNUmakefile" = True matches filename = extensionMatches [ "mk" ] filename ottMode :: TokenBasedMode StyleName ottMode = styleMode Ott.lexer & modeNameA .~ "ott" & modeAppliesA .~ anyExtension [ "ott" ] whitespaceMode :: TokenBasedMode StyleName whitespaceMode = styleMode Whitespace.lexer & modeNameA .~ "whitespace" & modeAppliesA .~ anyExtension [ "ws" ] & modeIndentA .~ (\_ _ -> insertB '\t') yi-misc-modes-0.18.0/src/Yi/Mode/Buffers.hs0000644000000000000000000000437113226661437016450 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Mode.Buffers -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- A minimalist emulation of emacs buffer menu mode, to be fleshed out later module Yi.Mode.Buffers (listBuffers) where import Control.Category ((>>>)) import Lens.Micro.Platform ((.=), (%~), (.~)) import Data.List.NonEmpty (toList) import qualified Data.Text as T (intercalate, pack) import System.FilePath (takeFileName) import Yi.Buffer import Yi.Editor import Yi.Keymap (Keymap, YiM, topKeymapA) import Yi.Keymap.Keys import qualified Yi.Rope as R (fromText, toString) -- | Retrieve buffer list and open a them in buffer mode using the -- 'bufferKeymap'. listBuffers :: YiM () listBuffers = do withEditor $ do bs <- toList <$> getBufferStack let bufferList = R.fromText . T.intercalate "\n" $ map identString bs bufRef <- stringToNewBuffer (MemBuffer "Buffer List") bufferList switchToBufferE bufRef withCurrentBuffer $ do modifyMode $ modeKeymapA .~ topKeymapA %~ bufferKeymap >>> modeNameA .~ "buffers" readOnlyA .= True -- | Switch to the buffer with name at current name. If it it starts -- with a @/@ then assume it's a file and try to open it that way. switch :: YiM () switch = do -- the YiString -> FilePath -> Text conversion sucks s <- R.toString <$> withCurrentBuffer readLnB let short = T.pack $ if take 1 s == "/" then takeFileName s else s withEditor $ switchToBufferWithNameE short -- | Keymap for the buffer mode. -- -- @ -- __p__ → line up -- __n__ or __SPACE__ → line down -- __ENTER__ or __f__ → open buffer -- __v__ → open buffer as read-only -- @ bufferKeymap :: Keymap -> Keymap bufferKeymap = important $ choice [ char 'p' ?>>! lineUp , oneOf [ char 'n', char ' ' ] >>! lineDown , oneOf [ spec KEnter, char 'f' ] >>! (switch >> setReadOnly False) , char 'v' ?>>! (switch >> setReadOnly True) ] where setReadOnly = withCurrentBuffer . (.=) readOnlyA yi-misc-modes-0.18.0/src/Yi/Mode/Abella.hs0000644000000000000000000001147313226661437016235 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Mode.Abella -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- 'Mode's and utility function for working with the Abella -- interactive theorem prover. module Yi.Mode.Abella ( abellaModeEmacs , abella , abellaEval , abellaEvalFromProofPoint , abellaUndo , abellaGet , abellaSend ) where import Lens.Micro.Platform (use, (%~), (&), (.=), (.~)) import Control.Monad (join, when) import Data.Binary (Binary) import Data.Char (isSpace) import Data.Default (Default) import Data.Maybe (isJust) import qualified Data.Text as T (isInfixOf, snoc, unpack) import Data.Typeable (Typeable) import Yi.Buffer import Yi.Core (sendToProcess) import Yi.Editor import Yi.Keymap (YiM, topKeymapA) import Yi.Keymap.Keys (Event, choice, ctrlCh, (<||), (?*>>!)) import qualified Yi.Lexer.Abella as Abella (Token, lexer) import Yi.MiniBuffer (CommandArguments (..)) import qualified Yi.Mode.Interactive as Interactive (spawnProcess) import Yi.Mode.Common (TokenBasedMode, anyExtension, styleMode) import qualified Yi.Rope as R (YiString, toText) import Yi.Types (YiVariable) abellaModeGen :: (Char -> [Event]) -> TokenBasedMode Abella.Token abellaModeGen abellaBinding = styleMode Abella.lexer & modeNameA .~ "abella" & modeAppliesA .~ anyExtension ["thm"] & modeToggleCommentSelectionA .~ Just (toggleCommentB "%") & modeKeymapA .~ topKeymapA %~ (<||) (choice [ abellaBinding 'p' ?*>>! abellaUndo , abellaBinding 'e' ?*>>! abellaEval , abellaBinding 'n' ?*>>! abellaNext , abellaBinding 'a' ?*>>! abellaAbort , abellaBinding '\r' ?*>>! abellaEvalFromProofPoint ]) abellaModeEmacs :: TokenBasedMode Abella.Token abellaModeEmacs = abellaModeGen (\ch -> [ctrlCh 'c', ctrlCh ch]) newtype AbellaBuffer = AbellaBuffer {_abellaBuffer :: Maybe BufferRef} deriving (Default, Typeable, Binary) instance YiVariable AbellaBuffer getProofPointMark :: BufferM Mark getProofPointMark = getMarkB $ Just "p" getTheoremPointMark :: BufferM Mark getTheoremPointMark = getMarkB $ Just "t" abellaEval :: YiM () abellaEval = do reg <- withCurrentBuffer . savingPointB $ do join ((.=) . markPointA <$> getProofPointMark <*> pointB) leftB readRegionB =<< regionOfNonEmptyB unitSentence abellaSend reg abellaEvalFromProofPoint :: YiM () abellaEvalFromProofPoint = abellaSend =<< withCurrentBuffer f where f = do mark <- getProofPointMark p <- use $ markPointA mark cur <- pointB markPointA mark .= cur readRegionB $ mkRegion p cur abellaNext :: YiM () abellaNext = do reg <- withCurrentBuffer $ rightB >> (readRegionB =<< regionOfNonEmptyB unitSentence) abellaSend reg withCurrentBuffer $ do moveB unitSentence Forward rightB untilB_ (not . isSpace <$> readB) rightB untilB_ ((/= '%') <$> readB) $ moveToEol >> rightB >> firstNonSpaceB join ((.=) . markPointA <$> getProofPointMark <*> pointB) abellaUndo :: YiM () abellaUndo = do abellaSend "undo." withCurrentBuffer $ do moveB unitSentence Backward join ((.=) . markPointA <$> getProofPointMark <*> pointB) abellaAbort :: YiM () abellaAbort = do abellaSend "abort." withCurrentBuffer $ do moveTo =<< use . markPointA =<< getTheoremPointMark join ((.=) . markPointA <$> getProofPointMark <*> pointB) -- | Start Abella in a buffer abella :: CommandArguments -> YiM BufferRef abella (CommandArguments args) = do b <- Interactive.spawnProcess "abella" (T.unpack <$> args) withEditor . putEditorDyn . AbellaBuffer $ Just b return b -- | Return Abella's buffer; create it if necessary. -- Show it in another window. abellaGet :: YiM BufferRef abellaGet = withOtherWindow $ do AbellaBuffer mb <- withEditor getEditorDyn case mb of Nothing -> abella (CommandArguments []) Just b -> do stillExists <- isJust <$> findBuffer b if stillExists then do withEditor $ switchToBufferE b return b else abella (CommandArguments []) -- | Send a command to Abella abellaSend :: R.YiString -> YiM () abellaSend cmd' = do let cmd = R.toText cmd' when ("Theorem" `T.isInfixOf` cmd) $ withCurrentBuffer $ join ((.=) . markPointA <$> getTheoremPointMark <*> pointB) b <- abellaGet withGivenBuffer b botB sendToProcess b . T.unpack $ cmd `T.snoc` '\n' yi-misc-modes-0.18.0/src/Yi/Mode/Latex.hs0000644000000000000000000000426613226661437016134 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Mode.Latex -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Collection of 'Mode's for working with LaTeX. module Yi.Mode.Latex (latexMode3, latexMode2, fastMode) where import Data.Text () import Yi.Buffer import qualified Yi.IncrementalParse as IncrParser (scanner) import Yi.Lexer.Alex (AlexState, CharScanner, Tok, commonLexer, lexScanner) import qualified Yi.Lexer.Latex as Latex (HlState, Token, alexScanToken, initState) import Yi.Mode.Common (anyExtension, fundamentalMode) import Yi.Syntax (ExtHL (ExtHL), Scanner, mkHighlighter) import qualified Yi.Syntax.Driver as Driver (mkHighlighter) import qualified Yi.Syntax.Latex as Latex (TT, Tree, getStrokes, parse, tokenToStroke) import Yi.Syntax.OnlineTree (Tree, manyToks) import Yi.Syntax.Tree (tokenBasedStrokes) abstract :: Mode syntax abstract = fundamentalMode { modeApplies = anyExtension ["tex", "sty", "ltx"], modeToggleCommentSelection = Just (toggleCommentB "%") } fastMode :: Mode (Tree Latex.TT) fastMode = abstract { modeName = "fast latex", modeHL = ExtHL $ mkHighlighter (IncrParser.scanner manyToks . latexLexer), modeGetStrokes = tokenBasedStrokes Latex.tokenToStroke } -- | syntax-based latex mode latexMode2 :: Mode (Latex.Tree Latex.TT) latexMode2 = abstract { modeName = "latex", modeHL = ExtHL $ mkHighlighter (IncrParser.scanner Latex.parse . latexLexer), modeGetStrokes = \t point begin end -> Latex.getStrokes point begin end t } -- | syntax-based latex mode latexMode3 :: Mode (Latex.Tree Latex.TT) latexMode3 = abstract { modeName = "latex", modeHL = ExtHL $ Driver.mkHighlighter (IncrParser.scanner Latex.parse . latexLexer), modeGetStrokes = \t point begin end -> Latex.getStrokes point begin end t } latexLexer :: CharScanner -> Scanner (AlexState Latex.HlState) (Tok Latex.Token) latexLexer = lexScanner (commonLexer Latex.alexScanToken Latex.initState) yi-misc-modes-0.18.0/src/Yi/Lexer/Abella.x0000644000000000000000000000625613226661437016270 0ustar0000000000000000-- -*- haskell -*- -- -- Lexical syntax for Abella -- -- (c) Nicolas Pouillard 2009 -- { #define NO_ALEX_CONTEXTS {-# OPTIONS -w #-} module Yi.Lexer.Abella ( lexer, tokenToText, TT, isComment, Token(..), HlState , Reserved(..), ReservedOp(..) ) where import Yi.Lexer.Alex hiding (tokenToStyle) import Yi.Style } $whitechar = [\ \t\n\r\f\v] $digit = 0-9 $small = [a-z] $large = [A-Z] $alpha = [$small $large] $idchar = [$alpha $digit \_ \'] $nl = [\n\r] @reservedid = Theorem|Define @reservedop = [\=\:\,\(\)\{\}] @varid = $large $idchar* @conid = [\' \_ $small] $idchar* @anyid = (@varid | @conid) @decimal = $digit+ abella :- <0> $white+ ; <0> { "%"[^$nl]* { c CommentLine } "exists" { c $ Reserved Exists } "forall" { c $ Reserved Forall } @reservedid { c $ Reserved Other } \\ { c $ ReservedOp BackSlash } \\\/ { c $ ReservedOp Or } \/\\ { c $ ReservedOp And } "->" { c $ ReservedOp RightArrow } "=>" { c $ ReservedOp DoubleRightArrow } "." { c $ ReservedOp Dot } @reservedop { c $ ReservedOp OtherOp } @decimal { c Number } "skip" { c Skip } @varid { c VarIdent } @conid { c ConsIdent } . { c Unrecognized } } { type HlState = Int data Reserved = Forall | Exists | Other deriving (Eq, Show) data ReservedOp = Or | And | BackSlash | RightArrow | DoubleRightArrow | Dot | OtherOp deriving (Eq, Show) data Token = Number | VarIdent | ConsIdent | Reserved !Reserved | ReservedOp !ReservedOp | CommentLine | Skip | Unrecognized deriving (Eq, Show) tokenToStyle :: Token -> StyleName tokenToStyle tok = case tok of Number -> numberStyle VarIdent -> variableStyle ConsIdent -> typeStyle ReservedOp _ -> operatorStyle Reserved _ -> keywordStyle CommentLine -> commentStyle Skip -> errorStyle Unrecognized -> errorStyle tokenToText :: Token -> Maybe String tokenToText (ReservedOp RightArrow) = Just "→ " tokenToText (ReservedOp DoubleRightArrow) = Just "⇒ " tokenToText (ReservedOp And) = Just "∧ " tokenToText (ReservedOp Or) = Just "∨ " tokenToText (Reserved Exists) = Just "∃" tokenToText (Reserved Forall) = Just "∀" tokenToText _ = Nothing isComment CommentLine = True isComment _ = False stateToInit = const 0 initState :: HlState initState = 0 type TT = Tok Token lexer :: StyleLexerASI HlState Token lexer = StyleLexer { _tokenToStyle = tokenToStyle , _styleLexer = commonLexer alexScanToken initState } #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Lexer/C.x0000644000000000000000000001052313226661437015262 0ustar0000000000000000-- -*- haskell -*- -- Simple lexer for c { #define NO_ALEX_CONTEXTS {-# OPTIONS -w #-} -- Alex generate warnings-ridden code. module Yi.Lexer.C ( lexer ) where {- Standard Library Modules Imported -} import Yi.Lexer.Alex hiding (tokenToStyle) {- External Library Modules Imported -} {- Local Modules Imported -} import qualified Yi.Syntax import Yi.Style } $whitechar = [\ \t\n\r\f\v] $special = [\(\)\,\;\[\]\`\{\}] $ascdigit = 0-9 $unidigit = [] -- TODO $digit = [$ascdigit $unidigit] $ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] $unisymbol = [] -- TODO $symbol = [$ascsymbol $unisymbol] # [$special \_\:\"\'] $large = [A-Z \xc0-\xd6 \xd8-\xde] $small = [a-z \xdf-\xf6 \xf8-\xff \_] $alpha = [$small $large] $graphic = [$small $large $symbol $digit $special \:\"\'] $octit = 0-7 $hexit = [0-9 A-F a-f] $idchar = [$alpha $digit \'] $symchar = [$symbol \:] $nl = [\n\r] @reservedid = auto | break | case | char | const | continue | default | do | double | else | enum | extern | float | for | goto | if | int | long | register | return | short | signed | static | struct | switch | typedef | union | unsigned | void | volatile | while @cppid = "#define" | "#defined" | "#if" | "#ifdef" | "#ifndef" | "#elif" | "#else" | "#endif" | "#include" -- From this list, but only the C ones: http://en.wikipedia.org/wiki/Operators_in_C_and_C%2B%2B @reservedop = "+" | "++" | "+=" | "-" | "--" | "-=" | "*" | "*=" | "/" | "/=" | "%" | "%=" | "<" | "<=" | ">" | ">=" | "!=" | "==" | "!" | "&&" | "||" | "<<" | "<<=" | ">>" | ">>=" | "~" | "&" | "&=" | "|" | "|=" | "^" | "^=" | "=" | "->" | "." | "," | "?" | ":" | "sizeof" @varid = $small $idchar* @conid = $large $idchar* @varsym = $symbol $symchar* @consym = \: $symchar* @decimal = $digit+ @octal = $octit+ @hexadecimal = $hexit+ @exponent = [eE] [\-\+] @decimal $cntrl = [$large \@\[\\\]\^\_] @ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM | SUB | ESC | FS | GS | RS | US | SP | DEL $charesc = [abfnrtv\\\"\'\&] @escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal) @gap = \\ $whitechar+ \\ @string = $graphic # [\"\\] | " " | @escape | @gap c :- <0> $white+ { c defaultStyle } -- whitespace { -- We could do nested comments like this -- "/*" { m (subtract 1) blockCommentStyle } "*/" { m (+1) blockCommentStyle } $white+ ; -- Whitespace . { c blockCommentStyle } } <0> { "//"[^\n]* { c commentStyle } "/*".*"*/" { c blockCommentStyle } "/*" @reservedop* { m (subtract 1) blockCommentStyle } $special { c defaultStyle } @reservedid { c keywordStyle } @cppid { c preprocessorStyle } @varid { c defaultStyle } @conid { c typeStyle } @reservedop { c operatorStyle } @varsym { c operatorStyle } @consym { c typeStyle } @decimal | 0[oO] @octal | 0[xX] @hexadecimal { c defaultStyle } @decimal \. @decimal @exponent? | @decimal @exponent { c defaultStyle } \' ($graphic # [\'\\] | " " | @escape) \' { c stringStyle } \" @string* \" { c stringStyle } . { c operatorStyle } } { type HlState = Int type Token = StyleName lexer :: StyleLexerASI HlState Token lexer = StyleLexer { _tokenToStyle = id , _styleLexer = commonLexer alexScanToken initState } stateToInit :: HlState -> Int stateToInit x | x < 0 = nestcomm | otherwise = 0 initState :: HlState initState = 0 #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Lexer/Cabal.x0000644000000000000000000001066713226661437016113 0ustar0000000000000000-- -*- haskell -*- -- -- Lexical syntax for Cabal files -- -- History: -- Adapted from the Haskell lexical syntax by Allan Clark -- Adapted to follow more closely the Cabal tool by Nicolas Pouillard -- { {-# OPTIONS -w #-} module Yi.Lexer.Cabal ( lexer ) where import Yi.Lexer.Alex hiding (tokenToStyle) import Yi.Style ( Style ( .. ) , StyleName , defaultStyle , commentStyle , blockCommentStyle , keywordStyle , operatorStyle , typeStyle , stringStyle , numberStyle ) } $whitechar = [\ \t\n\r\f\v] $special = [\(\)\,\;\[\]\`\{\}] $ascdigit = 0-9 $unidigit = [] -- TODO $digit = [$ascdigit $unidigit] $ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] $unisymbol = [] -- TODO $symbol = [$ascsymbol $unisymbol] # [$special \_\:\"\'] $large = [A-Z \xc0-\xd6 \xd8-\xde] $small = [a-z \xdf-\xf6 \xf8-\xff \_] $alpha = [$small $large] $graphic = [$small $large $symbol $digit $special \:\"\'] $octit = 0-7 $hexit = [0-9 A-F a-f] $idchar = [$alpha $digit \'] $symchar = [$symbol \:] $nl = [\n\r] @reservedid = GPL |LGPL |BSD3 |BSD4 |PublicDomain |AllRightsReserved |OtherLicense |if |[Ff]lag |else |[Oo][Ss] |[Aa]rch |[Tt]rue |[Ff]alse |[Ii]mpl @fieldid = [Aa]uthor |[Bb]ug\-[Rr]eports |[Bb]uild\-[Dd]epends |[Bb]uild\-[Tt]ype |[Bb]uild\-[Tt]ools |[Bb]uildable |[Cc]\-[Ss]ources |[Cc][Cc]\-[Oo]ptions |[Cc]abal\-[Vv]ersion |[Cc]ategory |[Cc]opyright |[Dd]ata\-[Dd]ir |[Dd]ata\-[Ff]iles |[Dd]efault |[Dd]escription |[Ee]xecutable |[Ee]xposed |[Ee]xposed\-[Mm]odules |[Ee]xtensions |[Ee]xtra\-[Ll]ibraries |[Ee]xtra\-[Ll]ib\-[Dd]irs |[Ee]xtra\-[Ss]ource\-[Ff]iles |[Ee]xtra\-[Tt]mp\-[Ff]iles |[Ff]rameworks |[Gg][Hh][Cc]\-[Oo]ptions |[Gg][Hh][Cc]\-[Pp]rof\-[Oo]ptions |[Gg][Hh][Cc]\-[Ss]hared\-[Oo]ptions |[Hh][Uu][Gg][Ss]\-[Oo]ptions |[Nn][Hh][Cc]98\-[Oo]ptions |[Hh]omepage |[Hh][Ss]\-[Ss]ource\-[Dd]irs |[Ii]nclude\-[Dd]irs |[Ii]ncludes |[Ii]nstall\-[Ii]ncludes |[Ll]icense |[Ll]icense\-[Ff]ile |[Ll][Dd]\-[Oo]ptions |[Mm]ain\-[Ii]s |[Mm]aintainer |[Nn]ame |[Oo]ther\-[Mm]odules |[Pp]ackage\-[Uu][Rr][Ll] |[Pp]kgconfig\-[Dd]epends |[Ss]tability |[Ss]ynopsis |[Tt]ested\-[Ww]ith |[Vv]ersion @sourcerepofieldid = [Tt]ype |[Ll]ocation |[Mm]odule |[Bb]ranch |[Tt]ag |[Ss]ubdir @reservedop = ">" | ">=" | "<" | "<=" @varid = $small $idchar* @conid = $large $idchar* @varsym = $symbol $symchar* @consym = \: $symchar* @decimal = $digit+ @octal = $octit+ @hexadecimal = $hexit+ $cntrl = [$large \@\[\\\]\^\_] @ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM | SUB | ESC | FS | GS | RS | US | SP | DEL $charesc = [abfnrtv\\\"\'\&] @escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal) @gap = \\ $whitechar+ \\ @string = $graphic # [\"\\] | " " | @escape | @gap main :- <0> { [\ \t]+ { c defaultStyle } $nl+ { c defaultStyle } ^ [\ \t]* "--" [^$nl]* $ { c commentStyle } $special { c defaultStyle } @reservedid { c keywordStyle } @varid { c defaultStyle } @conid { c defaultStyle } @fieldid ":" { c typeStyle } @sourcerepofieldid ":" { c typeStyle } @reservedop { c operatorStyle } @varsym { c operatorStyle } @consym { c defaultStyle } @decimal | 0[oO] @octal | 0[xX] @hexadecimal { c defaultStyle } @decimal \. @decimal { c defaultStyle } \' ($graphic # [\'\\] | " " | @escape) \' { c stringStyle } \" @string* \" { c stringStyle } . { c operatorStyle } } { type HlState = () type Token = StyleName stateToInit () = 0 initState :: HlState initState = () lexer :: StyleLexerASI HlState Token lexer = StyleLexer { _tokenToStyle = id , _styleLexer = commonLexer alexScanToken initState } #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Lexer/Clojure.x0000644000000000000000000001065013226661437016504 0ustar0000000000000000-- Lexical syntax for clojure. -- { #define NO_ALEX_CONTEXTS {-# OPTIONS -w #-} module Yi.Lexer.Clojure ( lexer ) where import Yi.Lexer.Alex hiding (tokenToStyle) import Yi.Style } -- generic (copied from Java.x) $whitechar = [\ \t\n\r\f\v] $special = [\(\)\,\;\:\[\]\`\{\}] $ascdigit = 0-9 $unidigit = [] -- TODO $digit = [$ascdigit $unidigit] $ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] $unisymbol = [] -- TODO $symbol = [$ascsymbol $unisymbol] # [$special \_\:\"\'] $large = [A-Z \xc0-\xd6 \xd8-\xde] $small = [a-z \xdf-\xf6 \xf8-\xff \_] $alpha = [$small $large] $graphic = [$small $large $symbol $digit $special \"\'] $literal = [$alpha $symbol $digit $special] $nonzerodigit = 1-9 $octit = 0-7 $hexit = [0-9 A-F a-f] $idchar = [$alpha $digit] $symchar = [$symbol] $nl = [\n\r] @digits = $nonzerodigit $digit* @integer = @digits $cntrl = [$large \@\[\\\]\^\_] @ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM | SUB | ESC | FS | GS | RS | US | SP | DEL $charesc = [abfnrtv\\\"\'\&] @escape = \\ ($charesc | @ascii | $ascdigit | o $octit | x $hexit) @gap = \\ $whitechar+ \\ @string = $graphic # [\"\\] | " " | @escape | @gap -- clojure-specific $nonnumericcljsymchar = [[\*\+\!\-\_\?\:] $alpha] $cljsymchar = [[\*\+\!\-\_\?\:] $alpha $digit] @cljsymbol = $nonnumericcljsymchar [$cljsymchar \.]* @cljkeyword = $nonnumericcljsymchar $cljsymchar* @loop = for | doseq | dotimes | while @branch = and | or | when | when\-not | when\-let | when\-first | if\-not | if\-let | cond | condp | case | when\-some | if\-some @reservedid = def | defn | defn\- | fn\? | ifn\? | definline | defmacro | defprotocol | defrecord | reify | extend\-type | ns | let | binding @keywordid = @reservedid | @branch | @loop @characterliterals = c | newline | space | tab | formfeed | backspace | "return" clojure :- { " { m (\x -> 0) regexStyle } $white+ ; -- Whitespace -- character literals \\ @characterliterals | \\ $literal -- unicode characters | \\ u $digit{4} -- octal characters | \\ o $digit{3} { c importStyle } . { c regexStyle } } { " { m (\x -> 0) stringStyle } $white+ ; -- Whitespace -- character literals \\ @characterliterals | \\ $literal -- unicode characters | \\ u $digit{4} -- octal characters | \\ o $digit{3} { c importStyle } . { c stringStyle } } <0> { $white+ { c defaultStyle } ";"[^\n]* { c commentStyle } @keywordid { c keywordStyle } $special { c defaultStyle } -- literal literals "true" | "false" | "nil" { c importStyle } -- character literals \\ @characterliterals | \\ $literal -- unicode characters | \\ u $digit{4} -- octal characters | \\ o $digit{3} { c importStyle } -- numeric literals @digits | @digits \N | @digits \/ @digits | @digits r @digits | @digits \. @digits? \M | @digits \. @digits? { c numberStyle } -- keywords ":"+ @cljkeyword { c preprocessorStyle } -- symbols @cljsymbol | @cljsymbol \/ @cljsymbol { c variableStyle } -- simple string handling " { m (\x -> 1) stringStyle } \#" { m (\x -> 2) regexStyle } . { c operatorStyle } } { type HlState = Int type Token = StyleName stateToInit :: HlState -> Int stateToInit x | x == 1 = string | x == 2 = regex | otherwise = 0 initState :: HlState initState = 0 lexer :: StyleLexerASI HlState Token lexer = StyleLexer { _tokenToStyle = id , _styleLexer = commonLexer alexScanToken initState } #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Lexer/Cplusplus.x0000644000000000000000000001052313226661437017072 0ustar0000000000000000-- -*- haskell -*- -- Simple lexer for c/c++ files { #define NO_ALEX_CONTEXTS {-# OPTIONS -w #-} module Yi.Lexer.Cplusplus ( lexer ) where {- Standard Library Modules Imported -} import Yi.Lexer.Alex hiding (tokenToStyle) {- External Library Modules Imported -} {- Local Modules Imported -} import qualified Yi.Syntax import Yi.Style {- End of Module Imports -} } $whitechar = [\ \t\n\r\f\v] $special = [\(\)\,\;\[\]\`\{\}] $ascdigit = 0-9 $unidigit = [] -- TODO $digit = [$ascdigit $unidigit] $ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] $unisymbol = [] -- TODO $symbol = [$ascsymbol $unisymbol] # [$special \_\:\"\'] $large = [A-Z \xc0-\xd6 \xd8-\xde] $small = [a-z \xdf-\xf6 \xf8-\xff \_] $alpha = [$small $large] $graphic = [$small $large $symbol $digit $special \:\"\'] $octit = 0-7 $hexit = [0-9 A-F a-f] $idchar = [$alpha $digit \'] $symchar = [$symbol \:] $nl = [\n\r] @reservedid = asm |break |case |continue |default |do |else |enum |for |fortran |goto |if |return |sizeof |struct |switch |typedef |union |while |_Bool |_Complex |_Imaginary |bool |char |double |float |int |long |short |signed |size_t |unsigned |void |auto |const |extern |inline |register |restrict |static |volatile |NULL |MAX |MIN |TRUE |FALSE |__LINE__ |__DATA__ |__FILE__ |__func__ |__TIME__ |__STDC__ |and |and_eq |bitand |bitor |catch |compl |const_cast |delete |dynamic_cast |false |for |friend |new |not |not_eq |operator |or |or_eq |private |protected |public |reinterpret_cast |static_cast |this |throw |true |try |typeid |using |xor |xor_eq |class |namespace |typename |template |virtual |bool |explicit |export |inline |mutable |wchar_t @reservedop = "->" | "*" | "+" | "-" | "%" | \\ | "||" | "&&" | "?" | ":" @varid = $small $idchar* @conid = $large $idchar* @varsym = $symbol $symchar* @consym = \: $symchar* @decimal = $digit+ @octal = $octit+ @hexadecimal = $hexit+ @exponent = [eE] [\-\+] @decimal $cntrl = [$large \@\[\\\]\^\_] @ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM | SUB | ESC | FS | GS | RS | US | SP | DEL $charesc = [abfnrtv\\\"\'\&] @escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal) @gap = \\ $whitechar+ \\ @string = $graphic # [\"\\] | " " | @escape | @gap haskell :- <0> $white+ { c defaultStyle } -- whitespace { -- We could do nested comments like this -- "/*" { m (subtract 1) blockCommentStyle } "*/" { m (+1) blockCommentStyle } $white+ { c defaultStyle } -- whitespace . { c blockCommentStyle } } <0> { "//"[^\n]* { c commentStyle } "/*" { m (subtract 1) blockCommentStyle } $special { c defaultStyle } @reservedid { c keywordStyle } @varid { c defaultStyle } @conid { c typeStyle } @reservedop { c operatorStyle } @varsym { c operatorStyle } @consym { c typeStyle } @decimal | 0[oO] @octal | 0[xX] @hexadecimal { c defaultStyle } @decimal \. @decimal @exponent? | @decimal @exponent { c defaultStyle } \' ($graphic # [\'\\] | " " | @escape) \' { c stringStyle } \" @string* \" { c stringStyle } . { c operatorStyle } } { type HlState = Int type Token = StyleName stateToInit x | x < 0 = nestcomm | otherwise = 0 initState :: HlState initState = 0 lexer :: StyleLexerASI HlState Token lexer = StyleLexer { _tokenToStyle = id , _styleLexer = commonLexer alexScanToken initState } #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Lexer/GNUMake.x0000644000000000000000000001376613226661437016343 0ustar0000000000000000-- -*- haskell -*- -- Lexer for Makefiles with consideration of GNU extensions -- This is based off the syntax as described in the GNU Make manual: -- http://www.gnu.org/software/make/manual/make.html -- Maintainer: Corey O'Connor { {-# OPTIONS -w #-} module Yi.Lexer.GNUMake ( lexer ) where import Yi.Lexer.Alex hiding (tokenToStyle) import Yi.Style ( Style ( .. ) , StyleName ) import qualified Yi.Style as Style } @varAssignOp = "=" | "?=" | "+=" | ":=" -- The documentation implies that {,},(, and ) can be used as single character variable names. -- "A variable name may be any sequence of characters not containing `:', `#', `=', or leading or -- trailing whitespace." -- http://www.gnu.org/software/make/manual/make.html#Using-Variables -- However when I try to feed GNU makefile containing such weird variable names GNU make fails. -- Though the specification does leave limiting the scope of valid variable names that as an open -- option for "the future" $varChar = $printable # [\: \# \= \ \{ \} \( \)] @directives = include | if | export | unexport | define @specialVars = MAKEFILE_LIST | ".DEFAULT_GOAL" | MAKE_RESTARTS | ".VARIABLES" | ".FEATURES" | ".INCLUDE_DIRS" | MAKE $space = [\ ] make :- <0> { -- All lines that start with a \t are passed to the shell post variable expansion and '\' -- handling. -- TODO: I'm almost convinced I'd like to see the tab character visually distinct from a space. -- One possibility would be to treat the tab character as an operator. ^\t { m (const RuleCommand) Style.defaultStyle } -- There can be any number of spaces (but not tabs!) preceeded a directive. ^$space+ { c Style.defaultStyle } -- The "include" directive can occur in two forms: -- One preceeded by a "-" -- Another not preceeded by a "-" \-?"include" { m (const IncludeDirective) Style.importStyle } -- A variable expansion outside of a prerequisite can occur in three different forms. -- Inside a prerequisite they can occur in four different forms. -- TODO: Highlight the automatic variables differently. -- 1. Single character variable names unless the character is a $. "$$" { c Style.defaultStyle } \$$varChar { c Style.variableStyle } -- 2 & 3: Parentheses or brackets could indicate a variable expansion or function call. "${" { m (const $ ComplexExpansion '}' TopLevel) Style.operatorStyle } "$(" { m (const $ ComplexExpansion ')' TopLevel) Style.operatorStyle } \# { m (const $ InComment) Style.commentStyle } \n { c Style.defaultStyle } . { c Style.defaultStyle } } -- The include directive is a space separated list. Optionally followed by a comment. { $space+ { c Style.defaultStyle } \# { m (const $ InComment) Style.commentStyle } \n { m (const $ TopLevel) Style.defaultStyle } -- For now anything else is considered a string. -- This is incorrect. The items of the space separated list can be: -- 0. File globs -- 1. Variable expansions -- 2. String literals . { c Style.stringStyle } } -- A variable expansion that starts with a parentheses or bracket could be a function call. For now -- everything up to the close character is considered part of the variable name. { $white+ { c Style.defaultStyle } -- Variable expansion is supported in a variable expansion. Unlike in a rule commmand the -- sequence $$ means the variable named $$. "$$" { c Style.variableStyle } \$$varChar { c Style.variableStyle } "${" { m (\this -> ComplexExpansion '}' this) Style.operatorStyle } "$(" { m (\this -> ComplexExpansion ')' this) Style.operatorStyle } ./ { \state preInput _ _ -> case state of ComplexExpansion endChar _ -> let currentChar = head $ alexCollectChar preInput in if (currentChar == endChar) then True else False _ -> False } { m (\(ComplexExpansion _ prevState) -> prevState) Style.operatorStyle } . { c Style.variableStyle } } -- After all the lines joined by a '\' character are appended together the text only undergoes -- variable expansion before being passed to the shell. -- This means that a '#' character only indicates a comment *only* if the shell interpretting the -- expanded text would consider it a comment. Wack huh? -- See 3.1 { -- If the \n is preceeded by a \ then the next line is part of this command even if there is no -- \t at the start. \\[.\n] { c Style.makeFileAction } \n { m (const $ TopLevel) Style.defaultStyle } -- Variable expansion is supported in a rule command. "$$" { c Style.makeFileAction } \$$varChar { c Style.variableStyle } "${" { m (const $ ComplexExpansion '}' RuleCommand) Style.operatorStyle } "$(" { m (const $ ComplexExpansion ')' RuleCommand) Style.operatorStyle } . { c Style.makeFileAction } } { -- Comments can be continued to the next line with a trailing slash. -- See 3.1 \\[.\n] { c Style.commentStyle } \n { m (const TopLevel) Style.defaultStyle } . { c Style.commentStyle } } { data HlState = TopLevel | InComment | IncludeDirective | ComplexExpansion Char HlState | RuleCommand deriving Show stateToInit TopLevel = 0 stateToInit InComment = comment stateToInit IncludeDirective = includeDirective stateToInit (ComplexExpansion _ _) = complexExpansion stateToInit RuleCommand = ruleCommand initState :: HlState initState = TopLevel type Token = StyleName lexer :: StyleLexerASI HlState Token lexer = StyleLexer { _tokenToStyle = id , _styleLexer = commonLexer alexScanToken initState } #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Lexer/GitCommit.x0000644000000000000000000000702113246272742016772 0ustar0000000000000000-- -*- haskell -*- -- Maintainer: Andrew Myers { {-# OPTIONS -w #-} module Yi.Lexer.GitCommit ( lexer, Token(..) ) where import Data.Monoid (mappend) import Yi.Lexer.Alex hiding (tokenToStyle) import Yi.Style ( StyleName ) import qualified Yi.Style as Style } $commitChars = [$printable\t] # [\#] @diffStart = diff\ \-\-git\ $commitChars* $nl = [\n\r] $notColon = $printable # [:] gitCommit :- -- The first line of a git commit message is the digest that is -- displayed as a summary of the commit in virtually all git tools. <0> { .+ { c Style.regexStyle } $nl { m (const SecondLine) Style.defaultStyle } } -- There should never be anything on the second line of a git commit message -- so it is styled in a deliberately hideous color scheme, unless it's a comment. { ^\# { m (const $ LineComment) Style.commentStyle } . { c (const $ Style.withFg Style.red `mappend` Style.withBg Style.brown) } $nl { m (const MessageLine) Style.defaultStyle } } -- The body of a commit message is broken up as follows -- * User's message -- * git generated information in comments -- * optional diff if commit was run with the -v option. { ^@diffStart$ { m (const $ DiffDeclaration) Style.regexStyle } \# { m (const $ LineComment) Style.commentStyle } $commitChars*$ { c Style.defaultStyle } $white { c Style.defaultStyle } . { c Style.defaultStyle } } -- Inside git generated comments specific information about what this -- commit will do is displayed. Highlight keywords and filenames. -- The notColon rule highlights filenames not preceded by keywords. -- The specific keywords rules switch to context to highlight -- everything to the end of the line (which should only ever be a filename.) { $nl { m (const MessageLine) Style.defaultStyle } \t$notColon+$ { c Style.preprocessorStyle } "modified:" { m (const Keyword) Style.keywordStyle } "new file:" { m (const Keyword) Style.keywordStyle } "deleted:" { m (const Keyword) Style.keywordStyle } . { c Style.commentStyle } } { $nl { m (const MessageLine) Style.defaultStyle } . { c Style.preprocessorStyle } } -- Highlight diff lines { ^@diffStart$ { c Style.regexStyle } ^\@\@.* { c Style.keywordStyle } ^\- .*$ { c Style.commentStyle } ^\+ .*$ { c Style.operatorStyle } ^.*$ { c Style.defaultStyle } $white { c Style.defaultStyle } . { c Style.defaultStyle } } { data HlState = Digest | SecondLine | Keyword | MessageLine | LineComment | DiffDeclaration deriving (Show, Eq) stateToInit Digest = 0 stateToInit SecondLine = secondLine stateToInit Keyword = keyword stateToInit MessageLine = body stateToInit DiffDeclaration = diff stateToInit LineComment = lineComment initState :: HlState initState = Digest type Token = StyleName lexer :: StyleLexerASI HlState Token lexer = StyleLexer { _tokenToStyle = id , _styleLexer = commonLexer alexScanToken initState } #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Lexer/JSON.x0000644000000000000000000000363413226661437015656 0ustar0000000000000000-- -*- haskell -*- -- -- Lexical syntax for JSON -- { #define NO_ALEX_CONTEXTS {-# OPTIONS -w #-} module Yi.Lexer.JSON ( lexer, Token(..)) where import Yi.Lexer.Alex hiding (tokenToStyle) import Yi.Style } $whitechar = [\ \t\n\r\f\v] $special = [\(\)\,\;\[\]\`\{\}\:] $ascdigit = 0-9 $unidigit = [] -- TODO $digit = [$ascdigit $unidigit] $large = [A-Z \xc0-\xd6 \xd8-\xde] $small = [a-z \xdf-\xf6 \xf8-\xff \_] $alpha = [$small $large] $ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] $unisymbol = [] -- TODO $symbol = [$ascsymbol $unisymbol] # [$special \_] $graphic = [$small $large $symbol $digit $special \"\'] $nonzerodigit = 1-9 $octit = 0-7 $hexit = [0-9 A-F a-f] $idchar = [$alpha $digit] $symchar = [$symbol] @digits = $nonzerodigit $digit* @octits = "0" $octit @hexits = "0x" $hexit @integer = @digits | @octits | @hexits @longinteger = @integer @number = @integer | @longinteger $cntrl = [$large \@\[\\\]\^\_] @ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM | SUB | ESC | FS | GS | RS | US | SP | DEL $charesc = [abfnrtv\\\"\'\&] @escape = \\ ($charesc | @ascii | @number) @string = $graphic # [\"\\] | " " | @escape json :- <0> { $white+ { c defaultStyle } null { c keywordStyle } \" @string* \" { c stringStyle } @number | @number \. @number? { c numberStyle } . { c defaultStyle } } { type HlState = Int type Token = StyleName stateToInit :: HlState -> Int stateToInit x = 0 initState :: HlState initState = 0 lexer :: StyleLexerASI HlState Token lexer = StyleLexer { _tokenToStyle = id , _styleLexer = commonLexer alexScanToken initState } #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Lexer/Java.x0000644000000000000000000001042013226661437015755 0ustar0000000000000000-- -*- haskell -*- -- Simple lexer for c { #define NO_ALEX_CONTEXTS {-# OPTIONS -w #-} -- Alex generate warnings-ridden code. module Yi.Lexer.Java ( lexer ) where {- Standard Library Modules Imported -} import Yi.Lexer.Alex hiding (tokenToStyle) {- External Library Modules Imported -} {- Local Modules Imported -} import qualified Yi.Syntax import Yi.Style } $whitechar = [\ \t\n\r\f\v] $special = [\(\)\,\;\[\]\`\{\}] $ascdigit = 0-9 $unidigit = [] -- TODO $digit = [$ascdigit $unidigit] $ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] $unisymbol = [] -- TODO $symbol = [$ascsymbol $unisymbol] # [$special \_\:\"\'] $large = [A-Z \xc0-\xd6 \xd8-\xde] $small = [a-z \xdf-\xf6 \xf8-\xff \_] $alpha = [$small $large] $graphic = [$small $large $symbol $digit $special \:\"\'] $octit = 0-7 $hexit = [0-9 A-F a-f] $idchar = [$alpha $digit \'] $symchar = [$symbol \:] $nl = [\n\r] @keywordid = abstract | assert | break | catch | class | case | const | continue | default | except | extends | else | false | finally | goto | final | for | if | implements | import | instanceof | interface | long | native | new | null | package | private | protected | public | return | static | switch | unsigned | volatile | while | super | switch | synchronized | this | throw | throws | true | transient | try | void | volatile | while @builtinTypes = char | byte | boolean | double | enum | float | int | long | short | void | String | Integer | Float | Double | Long @reservedop = "+" | "++" | "+=" | "-" | "--" | "-=" | "*" | "*=" | "/" | "/=" | "%" | "%=" | "<" | "<=" | ">" | ">=" | "!=" | "==" | "!" | "&&" | "||" | "<<" | "<<=" | ">>" | ">>=" | "~" | "&" | "&=" | "|" | "|=" | "^" | "^=" | "=" | "->" | "." | "," | "?" | ":" @varid = $small $idchar* @conid = $large $idchar* @varsym = $symbol $symchar* @consym = \: $symchar* @decimal = $digit+ @octal = $octit+ @hexadecimal = $hexit+ @exponent = [eE] [\-\+] @decimal $cntrl = [$large \@\[\\\]\^\_] @ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM | SUB | ESC | FS | GS | RS | US | SP | DEL $charesc = [abfnrtv\\\"\'\&] @escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal) @gap = \\ $whitechar+ \\ @string = $graphic # [\"\\] | " " | @escape | @gap java :- <0> $white+ { c defaultStyle } -- whitespace { "*/" { m (+1) blockCommentStyle } $white+ ; -- Whitespace . { c blockCommentStyle } } <0> { "//"[^\n]* { c commentStyle } "/*" @reservedop* { m (subtract 1) blockCommentStyle } $special { c defaultStyle } @keywordid { c keywordStyle } @builtinTypes { c typeStyle } @varid { c defaultStyle } @conid { c typeStyle } @reservedop { c operatorStyle } @varsym { c operatorStyle } @consym { c typeStyle } @decimal | 0[oO] @octal | 0[xX] @hexadecimal { c numberStyle } @decimal \. @decimal @exponent? | @decimal @exponent { c numberStyle } \' ($graphic # [\'\\] | " " | @escape) \' { c stringStyle } \" @string* \" { c stringStyle } . { c operatorStyle } } { type HlState = Int type Token = StyleName stateToInit :: HlState -> Int stateToInit x | x < 0 = nestcomm | otherwise = 0 initState :: HlState initState = 0 lexer :: StyleLexerASI HlState Token lexer = StyleLexer { _tokenToStyle = id , _styleLexer = commonLexer alexScanToken initState } #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Lexer/Latex.x0000644000000000000000000004037513226661437016165 0ustar0000000000000000-- -*- haskell -*- -- -- Simple syntax highlighting for Latex source files -- -- This is not intended to be a lexical analyser for -- latex, merely good enough to provide some syntax -- highlighting for latex source files. -- { #define NO_ALEX_CONTEXTS {-# OPTIONS -w #-} module Yi.Lexer.Latex ( initState, alexScanToken, Token(..), HlState, tokenToText ) where import Yi.Lexer.Alex hiding (tokenToStyle) import Yi.Style } $special = [\[\]\{\}\$\\\%\(\)\ ] $textChar = [~$special $white] $idchar = [a-zA-Z 0-9_\-] @reservedid = begin|end|newcommand @ident = $idchar+ @text = $textChar+ haskell :- "%"\-*[^\n]* { c $ Comment } $special { cs $ \(c:_) -> Special c } \\"begin{"@ident"}" { cs $ \s -> Begin (drop 6 s) } \\"end{"@ident"}" { cs $ \s -> End (drop 4 s) } \\$special { cs $ \(_:cs) -> Command cs } \\newcommand { c $ NewCommand } \\@ident { cs $ \(_:cs) -> Command cs } @text { c $ Text } { data Token = Comment | Text | Special !Char | Command !String | Begin !String | End !String | NewCommand deriving (Eq, Show, Ord) type HlState = Int {- See Haskell.x which uses this to say whether we are in a comment (perhaps a nested comment) or not. -} stateToInit x = 0 initState :: HlState initState = 0 tokenToText (Command "alpha") = Just "α" tokenToText (Command "beta") = Just "β" tokenToText (Command "gamma") = Just "γ" tokenToText (Command "delta") = Just "δ" tokenToText (Command "epsilon") = Just "∊" tokenToText (Command "varepsilon") = Just "ε" tokenToText (Command "zeta") = Just "ζ" tokenToText (Command "eta") = Just "η" tokenToText (Command "theta") = Just "θ" tokenToText (Command "vartheta") = Just "ϑ" tokenToText (Command "iota") = Just "ι" tokenToText (Command "kappa") = Just "κ" tokenToText (Command "lambda") = Just "λ" tokenToText (Command "mu") = Just "μ" tokenToText (Command "nu") = Just "ν" tokenToText (Command "xi") = Just "ξ" tokenToText (Command "pi") = Just "π" tokenToText (Command "varpi") = Just "ϖ" tokenToText (Command "rho") = Just "ρ" tokenToText (Command "varrho") = Just "ϱ" tokenToText (Command "sigma") = Just "σ" tokenToText (Command "varsigma") = Just "ς" tokenToText (Command "tau") = Just "τ" tokenToText (Command "upsilon") = Just "υ" tokenToText (Command "phi") = Just "φ" tokenToText (Command "varphi") = Just "ϕ" tokenToText (Command "chi") = Just "χ" tokenToText (Command "psi") = Just "ψ" tokenToText (Command "omega") = Just "ω" tokenToText (Command "Gamma") = Just "Γ" tokenToText (Command "Delta") = Just "Δ" tokenToText (Command "Theta") = Just "Θ" tokenToText (Command "Lambda") = Just "Λ" tokenToText (Command "Xi") = Just "Ξ" tokenToText (Command "Pi") = Just "Π" tokenToText (Command "Upsilon") = Just "Υ" tokenToText (Command "Phi") = Just "Φ" tokenToText (Command "Psi") = Just "Ψ" tokenToText (Command "Omega") = Just "Ω" tokenToText (Command "leq") = Just "≤" tokenToText (Command "ll") = Just "≪" tokenToText (Command "prec") = Just "≺" tokenToText (Command "preceq") = Just "≼" tokenToText (Command "subset") = Just "⊂" tokenToText (Command "subseteq") = Just "⊆" tokenToText (Command "sqsubset") = Just "⊏" tokenToText (Command "sqsubseteq") = Just "⊑" tokenToText (Command "in") = Just "∈" tokenToText (Command "vdash") = Just "⊢" tokenToText (Command "mid") = Just "∣" tokenToText (Command "smile") = Just "⌣" tokenToText (Command "geq") = Just "≥" tokenToText (Command "gg") = Just "≫" tokenToText (Command "succ") = Just "≻" tokenToText (Command "succeq") = Just "≽" tokenToText (Command "supset") = Just "⊃" tokenToText (Command "supseteq") = Just "⊇" tokenToText (Command "sqsupset") = Just "⊐" tokenToText (Command "sqsupseteq") = Just "⊒" tokenToText (Command "ni") = Just "∋" tokenToText (Command "dashv") = Just "⊣" tokenToText (Command "parallel") = Just "∥" tokenToText (Command "frown") = Just "⌢" tokenToText (Command "notin") = Just "∉" tokenToText (Command "equiv") = Just "≡" tokenToText (Command "doteq") = Just "≐" tokenToText (Command "sim") = Just "∼" tokenToText (Command "simeq") = Just "≃" tokenToText (Command "approx") = Just "≈" tokenToText (Command "cong") = Just "≅" tokenToText (Command "Join") = Just "⋈" tokenToText (Command "bowtie") = Just "⋈" tokenToText (Command "propto") = Just "∝" tokenToText (Command "models") = Just "⊨" tokenToText (Command "perp") = Just "⊥" tokenToText (Command "asymp") = Just "≍" tokenToText (Command "neq") = Just "≠" tokenToText (Command "pm") = Just "±" tokenToText (Command "cdot") = Just "⋅" tokenToText (Command "times") = Just "×" tokenToText (Command "cup") = Just "∪" tokenToText (Command "sqcup") = Just "⊔" tokenToText (Command "vee") = Just "∨" tokenToText (Command "oplus") = Just "⊕" tokenToText (Command "odot") = Just "⊙" tokenToText (Command "otimes") = Just "⊗" tokenToText (Command "bigtriangleup") = Just "△" tokenToText (Command "lhd") = Just "⊲" tokenToText (Command "unlhd") = Just "⊴" tokenToText (Command "mp") = Just "∓" tokenToText (Command "div") = Just "÷" tokenToText (Command "setminus") = Just "∖" tokenToText (Command "cap") = Just "∩" tokenToText (Command "sqcap") = Just "⊓" tokenToText (Command "wedge") = Just "∧" tokenToText (Command "ominus") = Just "⊖" tokenToText (Command "oslash") = Just "⊘" tokenToText (Command "bigcirc") = Just "○" tokenToText (Command "bigtriangledown") = Just "▽" tokenToText (Command "rhd") = Just "⊳" tokenToText (Command "unrhd") = Just "⊵" tokenToText (Command "triangleleft") = Just "◁" tokenToText (Command "triangleright") = Just "▷" tokenToText (Command "star") = Just "⋆" tokenToText (Command "ast") = Just "∗" tokenToText (Command "circ") = Just "∘" tokenToText (Command "bullet") = Just "∙" tokenToText (Command "diamond") = Just "⋄" tokenToText (Command "uplus") = Just "⊎" tokenToText (Command "dagger") = Just "†" tokenToText (Command "ddagger") = Just "‡" tokenToText (Command "wr") = Just "≀" tokenToText (Command "sum") = Just "∑" tokenToText (Command "prod") = Just "∏" tokenToText (Command "coprod") = Just "∐" tokenToText (Command "int") = Just "∫" tokenToText (Command "bigcup") = Just "⋃" tokenToText (Command "bigcap") = Just "⋂" tokenToText (Command "bigsqcup") = Just "⊔" tokenToText (Command "oint") = Just "∮" tokenToText (Command "bigvee") = Just "⋁" tokenToText (Command "bigwedge") = Just "⋀" tokenToText (Command "bigoplus") = Just "⊕" tokenToText (Command "bigotimes") = Just "⊗" tokenToText (Command "bigodot") = Just "⊙" tokenToText (Command "biguplus") = Just "⊎" tokenToText (Command "leftarrow") = Just "←" tokenToText (Command "rightarrow") = Just "→" tokenToText (Command "leftrightarrow") = Just "↔" tokenToText (Command "Leftarrow") = Just "⇐" tokenToText (Command "Rightarrow") = Just "⇒" tokenToText (Command "Leftrightarrow") = Just "⇔" tokenToText (Command "mapsto") = Just "↦" tokenToText (Command "hookleftarrow") = Just "↩" tokenToText (Command "leftharpoonup") = Just "↼" tokenToText (Command "leftharpoondown") = Just "↽" tokenToText (Command "hookrightarrow") = Just "↪" tokenToText (Command "rightharpoonup") = Just "⇀" tokenToText (Command "rightharpoondown") = Just "⇁" tokenToText (Command "longleftarrow") = Just "←" tokenToText (Command "longrightarrow") = Just "→" tokenToText (Command "longleftrightarrow") = Just "↔" tokenToText (Command "Longleftarrow") = Just "⇐" tokenToText (Command "Longrightarrow") = Just "⇒" tokenToText (Command "Longleftrightarrow") = Just "⇔" tokenToText (Command "longmapsto") = Just "⇖" tokenToText (Command "uparrow") = Just "↑" tokenToText (Command "downarrow") = Just "↓" tokenToText (Command "updownarrow") = Just "↕" tokenToText (Command "Uparrow") = Just "⇑" tokenToText (Command "Downarrow") = Just "⇓" tokenToText (Command "Updownarrow") = Just "⇕" tokenToText (Command "nearrow") = Just "↗" tokenToText (Command "searrow") = Just "↘" tokenToText (Command "swarrow") = Just "↙" tokenToText (Command "nwarrow") = Just "↖" tokenToText (Command "leadsto") = Just "↝" tokenToText (Command "dots") = Just "…" tokenToText (Command "cdots") = Just "⋯" tokenToText (Command "vdots") = Just "⋮" tokenToText (Command "ddots") = Just "⋱" tokenToText (Command "hbar") = Just "ℏ" tokenToText (Command "ell") = Just "ℓ" tokenToText (Command "Re") = Just "ℜ" tokenToText (Command "Im") = Just "ℑ" tokenToText (Command "aleph") = Just "א" tokenToText (Command "wp") = Just "℘" tokenToText (Command "forall") = Just "∀" tokenToText (Command "exists") = Just "∃" tokenToText (Command "mho") = Just "℧" tokenToText (Command "partial") = Just "∂" tokenToText (Command "prime") = Just "′" tokenToText (Command "emptyset") = Just "∅" tokenToText (Command "infty") = Just "∞" tokenToText (Command "nabla") = Just "∇" tokenToText (Command "triangle") = Just "△" tokenToText (Command "Box") = Just "□" tokenToText (Command "Diamond") = Just "◇" tokenToText (Command "bot") = Just "⊥" tokenToText (Command "top") = Just "⊤" tokenToText (Command "angle") = Just "∠" tokenToText (Command "surd") = Just "√" tokenToText (Command "diamondsuit") = Just "♢" tokenToText (Command "heartsuit") = Just "♡" tokenToText (Command "clubsuit") = Just "♣" tokenToText (Command "spadesuit") = Just "♠" tokenToText (Command "neg") = Just "¬" tokenToText (Command "flat") = Just "♭" tokenToText (Command "natural") = Just "♮" tokenToText (Command "sharp") = Just "♯" tokenToText (Command "digamma") = Just "Ϝ" tokenToText (Command "varkappa") = Just "ϰ" tokenToText (Command "beth") = Just "ב" tokenToText (Command "daleth") = Just "ד" tokenToText (Command "gimel") = Just "ג" tokenToText (Command "lessdot") = Just "⋖" tokenToText (Command "leqslant") = Just "≤" tokenToText (Command "leqq") = Just "≦" tokenToText (Command "lll") = Just "⋘" tokenToText (Command "lesssim") = Just "≲" tokenToText (Command "lessgtr") = Just "≶" tokenToText (Command "lesseqgtr") = Just "⋚" tokenToText (Command "preccurlyeq") = Just "≼" tokenToText (Command "curlyeqprec") = Just "⋞" tokenToText (Command "precsim") = Just "≾" tokenToText (Command "Subset") = Just "⋐" tokenToText (Command "sqsubset") = Just "⊏" tokenToText (Command "therefore") = Just "∴" tokenToText (Command "smallsmile") = Just "⌣" tokenToText (Command "vartriangleleft") = Just "⊲" tokenToText (Command "trianglelefteq") = Just "⊴" tokenToText (Command "gtrdot") = Just "⋗" tokenToText (Command "geqq") = Just "≧" tokenToText (Command "ggg") = Just "⋙" tokenToText (Command "gtrsim") = Just "≳" tokenToText (Command "gtrless") = Just "≷" tokenToText (Command "gtreqless") = Just "⋛" tokenToText (Command "succcurlyeq") = Just "≽" tokenToText (Command "curlyeqsucc") = Just "⋟" tokenToText (Command "succsim") = Just "≿" tokenToText (Command "Supset") = Just "⋑" tokenToText (Command "sqsupset") = Just "⊐" tokenToText (Command "because") = Just "∵" tokenToText (Command "shortparallel") = Just "∥" tokenToText (Command "smallfrown") = Just "⌢" tokenToText (Command "vartriangleright") = Just "⊳" tokenToText (Command "trianglerighteq") = Just "⊵" tokenToText (Command "doteqdot") = Just "≑" tokenToText (Command "risingdotseq") = Just "≓" tokenToText (Command "fallingdotseq") = Just "≒" tokenToText (Command "eqcirc") = Just "≖" tokenToText (Command "circeq") = Just "≗" tokenToText (Command "triangleq") = Just "≜" tokenToText (Command "bumpeq") = Just "≏" tokenToText (Command "Bumpeq") = Just "≎" tokenToText (Command "thicksim") = Just "∼" tokenToText (Command "thickapprox") = Just "≈" tokenToText (Command "approxeq") = Just "≊" tokenToText (Command "backsim") = Just "∽" tokenToText (Command "vDash") = Just "⊨" tokenToText (Command "Vdash") = Just "⊩" tokenToText (Command "Vvdash") = Just "⊪" tokenToText (Command "backepsilon") = Just "∍" tokenToText (Command "varpropto") = Just "∝" tokenToText (Command "between") = Just "≬" tokenToText (Command "pitchfork") = Just "⋔" tokenToText (Command "blacktriangleleft") = Just "◀" tokenToText (Command "blacktriangleright") = Just "▷" tokenToText (Command "dashleftarrow") = Just "⇠" tokenToText (Command "leftleftarrows") = Just "⇇" tokenToText (Command "leftrightarrows") = Just "⇆" tokenToText (Command "Lleftarrow") = Just "⇚" tokenToText (Command "twoheadleftarrow") = Just "↞" tokenToText (Command "leftarrowtail") = Just "↢" tokenToText (Command "leftrightharpoons") = Just "⇋" tokenToText (Command "Lsh") = Just "↰" tokenToText (Command "looparrowleft") = Just "↫" tokenToText (Command "curvearrowleft") = Just "↶" tokenToText (Command "circlearrowleft") = Just "↺" tokenToText (Command "dashrightarrow") = Just "⇢" tokenToText (Command "rightrightarrows") = Just "⇉" tokenToText (Command "rightleftarrows") = Just "⇄" tokenToText (Command "Rrightarrow") = Just "⇛" tokenToText (Command "twoheadrightarrow") = Just "↠" tokenToText (Command "rightarrowtail") = Just "↣" tokenToText (Command "rightleftharpoons") = Just "⇌" tokenToText (Command "Rsh") = Just "↱" tokenToText (Command "looparrowright") = Just "↬" tokenToText (Command "curvearrowright") = Just "↷" tokenToText (Command "circlearrowright") = Just "↻" tokenToText (Command "multimap") = Just "⊸" tokenToText (Command "upuparrows") = Just "⇈" tokenToText (Command "downdownarrows") = Just "⇊" tokenToText (Command "upharpoonleft") = Just "↿" tokenToText (Command "upharpoonright") = Just "↾" tokenToText (Command "downharpoonleft") = Just "⇃" tokenToText (Command "downharpoonright") = Just "⇂" tokenToText (Command "rightsquigarrow") = Just "⇝" tokenToText (Command "leftrightsquigarrow") = Just "↭" tokenToText (Command "dotplus") = Just "∔" tokenToText (Command "ltimes") = Just "⋉" tokenToText (Command "Cup") = Just "⋓" tokenToText (Command "veebar") = Just "⊻" tokenToText (Command "boxplus") = Just "⊞" tokenToText (Command "boxtimes") = Just "⊠" tokenToText (Command "leftthreetimes") = Just "⋋" tokenToText (Command "curlyvee") = Just "⋎" tokenToText (Command "centerdot") = Just "⋅" tokenToText (Command "rtimes") = Just "⋈" tokenToText (Command "Cap") = Just "⋒" tokenToText (Command "barwedge") = Just "⊼" tokenToText (Command "boxminus") = Just "⊟" tokenToText (Command "boxdot") = Just "⊡" tokenToText (Command "rightthreetimes") = Just "⋌" tokenToText (Command "curlywedge") = Just "⋏" tokenToText (Command "intercal") = Just "⊺" tokenToText (Command "divideontimes") = Just "⋇" tokenToText (Command "smallsetminus") = Just "∖" tokenToText (Command "circleddash") = Just "⊝" tokenToText (Command "circledcirc") = Just "⊚" tokenToText (Command "circledast") = Just "⊛" tokenToText (Command "hbar") = Just "ℏ" tokenToText (Command "hslash") = Just "ℏ" tokenToText (Command "square") = Just "□" tokenToText (Command "blacksquare") = Just "■" tokenToText (Command "circledS") = Just "Ⓢ" tokenToText (Command "vartriangle") = Just "△" tokenToText (Command "blacktriangle") = Just "▲" tokenToText (Command "complement") = Just "∁" tokenToText (Command "triangledown") = Just "▽" tokenToText (Command "blacktriangledown") = Just "▼" tokenToText (Command "lozenge") = Just "◊" tokenToText (Command "blacklozenge") = Just "◆" tokenToText (Command "bigstar") = Just "★" tokenToText (Command "angle") = Just "∠" tokenToText (Command "measuredangle") = Just "∡" tokenToText (Command "sphericalangle") = Just "∢" tokenToText (Command "backprime") = Just "‵" tokenToText (Command "nexists") = Just "∄" tokenToText (Command "Finv") = Just "Ⅎ" tokenToText (Command "varnothing") = Just "∅" tokenToText (Command "eth") = Just "ð" tokenToText (Command "mho") = Just "℧" tokenToText (Command "AA") = Just "Å" tokenToText (Command "euro") = Just "€" tokenToText (Command "degree") = Just "°" tokenToText (Command "lnot") = Just "¬" tokenToText (Command "textdegree") = Just "°" tokenToText (Command "textlnot") = Just "¬" tokenToText (Command "textsurd") = Just "√" tokenToText (Command "textdiv") = Just "÷" tokenToText (Command "textpm") = Just "±" tokenToText _ = Nothing #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Lexer/OCaml.x0000644000000000000000000001046013226661437016073 0ustar0000000000000000-- -*- haskell -*- -- -- Lexical syntax for OCaml -- -- (c) Nicolas Pouillard 2008 -- { #define NO_ALEX_CONTEXTS {-# OPTIONS -w #-} module Yi.Lexer.OCaml ( lexer, Token(..) ) where import Yi.Lexer.Alex hiding (tokenToStyle) import Yi.Style } $whitechar = [\ \t\n\r\f\v] $special = [\(\)\,\;\[\]\`\{\}] -- OCAML CHECK $digit = 0-9 $ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] -- OCAML CHECK $symbol = $ascsymbol # [$special \_\:\"\'] -- OCAML CHECK $large = [A-Z \xc0-\xd6 \xd8-\xde] -- OCAML CHECK $small = [a-z \xdf-\xf6 \xf8-\xff \_] -- OCAML CHECK $alpha = [$small $large] $graphic = [$small $large $symbol $digit $special \:\"\'] -- OCAML CHECK $bit = 0-1 $octit = 0-7 $hexit = [0-9 A-F a-f] $idchar = [$alpha $digit \'] $symchar = [$symbol \:] -- OCAML CHECK $nl = [\n\r] @revisedReservedId = value|declare @reservedid = and|as|asr|assert|begin|class|constraint|do|done|downto|else|end| exception|external|as|assert|false|for|fun|function|if|in|include| inherit|initializer|land|lor|lxor|lsl|lsr|lazy|let|match|method|mod| module|mutable|new|object|of|open|or|parser|private|raise|rec|sig| struct|then|to|true|try|type|val|virtual|when|while|with| @revisedReservedId @reservedop = "=" | ":=" | "?" | \\ | "|" | "<-" | "->" | "~" -- OCAML CHECK @varid = $small $idchar* @conid = $large $idchar* @varsym = $symbol $symchar* @consym = \:\: $symchar* @binary = $bit+ @decimal = $digit+ @octal = $octit+ @hexadecimal = $hexit+ @exponent = [eE] [\-\+] @decimal @number = @decimal | 0[bB] @binary | 0[oO] @octal | 0[xX] @hexadecimal | @decimal \. @decimal @exponent? | @decimal @exponent @numberPostfix = [lLn]? -- OCAML CHECK $cntrl = [$large \@\[\\\]\^\_] @ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM | SUB | ESC | FS | GS | RS | US | SP | DEL $charesc = [abfnrtv\\\"\'\&] @escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal) @gap = \\ $whitechar+ \\ @string = $graphic # [\"\\] | " " | @escape | @gap ocaml :- <0> $white+ ; { "(*" { m (subtract 1) Comment } "*)" { m (+1) Comment } $white+ ; -- whitespace . { c Comment } } <0> { "(*" { m (subtract 1) Comment } $special { \str st -> (st, Special (snd $ head str)) } @reservedid { c Reserved } @varid { c VarIdent } @conid { c ConsIdent } @reservedop { c Operator } @varsym { c Operator } @consym { c ConsOperator } @number @numberPostfix { c Number } \' ($graphic # [\'\\] | " " | @escape) \' { c CharTok } \" @string* \" { c StringTok } . { c Operator } } { type HlState = Int data Token = Number | CharTok | StringTok | VarIdent | ConsIdent | IndentReserved | Reserved | ReservedOp | Special Char | ConsOperator | Operator | Comment deriving (Eq, Show) lexer :: StyleLexerASI HlState Token lexer = StyleLexer { _tokenToStyle = tokenToStyle , _styleLexer = commonLexer alexScanToken initState } tokenToStyle :: Token -> StyleName tokenToStyle tok = case tok of Number -> defaultStyle CharTok -> stringStyle StringTok -> stringStyle VarIdent -> defaultStyle ConsIdent -> typeStyle ReservedOp -> operatorStyle Reserved -> keywordStyle IndentReserved -> keywordStyle Special _ -> defaultStyle ConsOperator -> typeStyle Operator -> operatorStyle Comment -> commentStyle stateToInit x | x < 0 = nestcomm | otherwise = 0 initState :: HlState initState = 0 #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Lexer/ObjectiveC.x0000644000000000000000000001100013226661437017104 0ustar0000000000000000-- -*- haskell -*- -- Simple lexer for objective-c { #define NO_ALEX_CONTEXTS {-# OPTIONS -w #-} -- Alex generate warnings-ridden code. module Yi.Lexer.ObjectiveC ( lexer ) where {- Standard Library Modules Imported -} import Yi.Lexer.Alex hiding (tokenToStyle) {- External Library Modules Imported -} {- Local Modules Imported -} import qualified Yi.Syntax import Yi.Style } $whitechar = [\ \t\n\r\f\v] $special = [\(\)\,\;\[\]\`\{\}] $ascdigit = 0-9 $unidigit = [] -- TODO $digit = [$ascdigit $unidigit] $ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] $unisymbol = [] -- TODO $symbol = [$ascsymbol $unisymbol] # [$special \_\:\"\'] $large = [A-Z \xc0-\xd6 \xd8-\xde] $small = [a-z \xdf-\xf6 \xf8-\xff \_] $alpha = [$small $large] $graphic = [$small $large $symbol $digit $special \:\"\'] $octit = 0-7 $hexit = [0-9 A-F a-f] $idchar = [$alpha $digit \'] $symchar = [$symbol \:] $nl = [\n\r] @reservedid = auto | break | case | char | const | continue | default | do | double | else | enum | extern | float | for | goto | if | int | long | register | return | short | signed | static | struct | switch | typedef | union | unsigned | void | volatile | while | "@class" | "@interface" | "@implementation" | "@public" | "@private" | "@protected" | "@try" | "@catch" | "@throw" | "@finally" | "@end" | "@protocol" | "@optional" | "@required" | "@selector" | "@synchronized" | "@defs" | "@encode" | "@property" | "@synthesize" | "@dynamic" | nil | Nil | id | SEL | BOOL | in | out | inout | bycopy | byref | oneway | YES | NO -- From this list, but only the C ones: http://en.wikipedia.org/wiki/Operators_in_C_and_C%2B%2B @reservedop = "+" | "++" | "+=" | "-" | "--" | "-=" | "*" | "*=" | "/" | "/=" | "%" | "%=" | "<" | "<=" | ">" | ">=" | "!=" | "==" | "!" | "&&" | "||" | "<<" | "<<=" | ">>" | ">>=" | "~" | "&" | "&=" | "|" | "|=" | "^" | "^=" | "=" | "->" | "." | "," | "?" | ":" | "sizeof" @varid = $small $idchar* @conid = $large $idchar* @varsym = $symbol $symchar* @consym = \: $symchar* @decimal = $digit+ @octal = $octit+ @hexadecimal = $hexit+ @exponent = [eE] [\-\+] @decimal $cntrl = [$large \@\[\\\]\^\_] @ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM | SUB | ESC | FS | GS | RS | US | SP | DEL $charesc = [abfnrtv\\\"\'\&] @escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal) @gap = \\ $whitechar+ \\ @string = $graphic # [\"\\] | " " | @escape | @gap haskell :- <0> $white+ { c defaultStyle } -- whitespace { -- We could do nested comments like this -- "/*" { m (subtract 1) blockCommentStyle } "*/" { m (+1) blockCommentStyle } $white+ { c defaultStyle } -- whitespace . { c blockCommentStyle } } <0> { "//"[^\n]* { c commentStyle } "/*" { m (subtract 1) blockCommentStyle } $special { c defaultStyle } @reservedid { c keywordStyle } @varid { c defaultStyle } @conid { c typeStyle } @reservedop { c operatorStyle } @varsym { c operatorStyle } @consym { c typeStyle } @decimal | 0[oO] @octal | 0[xX] @hexadecimal { c defaultStyle } @decimal \. @decimal @exponent? | @decimal @exponent { c defaultStyle } \' ($graphic # [\'\\] | " " | @escape) \' { c stringStyle } \" @string* \" { c stringStyle } . { c operatorStyle } } { type HlState = Int type Token = StyleName stateToInit x | x < 0 = nestcomm | otherwise = 0 initState :: HlState initState = 0 lexer :: StyleLexerASI HlState Token lexer = StyleLexer { _tokenToStyle = id , _styleLexer = commonLexer alexScanToken initState } #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Lexer/Ott.x0000644000000000000000000000677213226661437015661 0ustar0000000000000000-- -*- haskell -*- { #define NO_ALEX_CONTEXTS {- The Ott website: http://www.cl.cam.ac.uk/~pes20/ott -} {-# OPTIONS -w #-} module Yi.Lexer.Ott ( lexer ) where import Yi.Lexer.Alex hiding (tokenToStyle) import Yi.Style ( Style ( .. ) , StyleName ) import Yi.Style } @reservedid = metavar | indexvar | grammar | embed | subrules | contextrules | substitutions | single | multiple | freevars | defns | defn | by | homs | funs | fun | parsing | left | right @reservedop = "::" | "::=" | "_::" | "<::" | "<=" | "/>" | "//" | " $white+ ; <0> { $white+ ; -- whitespace "%"[^\n]* { c commentStyle } ">>" { m (subtract 1) commentStyle } @reservedid { c keywordStyle } @reservedop { c operatorStyle } "|" $white+ { c operatorStyle } "(+" { m (const bindspec) numberStyle } "{{" { m (const beginHom) stringStyle } . { c defaultStyle } } { ">>" { m (subtract 1) commentStyle } "<<" { m (+1) commentStyle } $white+ ; -- whitespace . { c commentStyle } } { "bind" | "in" | "union" | "{" | "}" { c numberStyle } $white+ ; -- whitespace "+)" { m (const 0) numberStyle } . { c defaultStyle } } { $white+ ; -- whitespace @homid { m (const hom) typeStyle } "}}" { m (const 0) stringStyle } . { m (const hom) defaultStyle } } { "[[" { m (const splice) stringStyle } $white+ ; -- whitespace "}}" { m (const 0) stringStyle } . { c defaultStyle } } { "]]" { m (const hom) stringStyle } $white+ ; -- whitespace . { c defaultStyle } } { type HlState = Int stateToInit x | x < 0 = nestcomm | otherwise = x initState :: HlState initState = 0 type Token = StyleName lexer :: StyleLexerASI HlState Token lexer = StyleLexer { _tokenToStyle = id , _styleLexer = commonLexer alexScanToken initState } #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Lexer/Perl.x0000644000000000000000000003702313226661437016006 0ustar0000000000000000-- -*- haskell -*- -- Simple lexer for Perl source files. -- This started as a copy of the C++ lexer so some bits and pieces don't make sense for Perl. -- Maintainer: Corey O'Connor { {-# OPTIONS -w #-} module Yi.Lexer.Perl ( lexer ) where {- Standard Library Modules Imported -} import Yi.Lexer.Alex hiding (tokenToStyle) {- External Library Modules Imported -} {- Local Modules Imported -} import qualified Yi.Syntax import Yi.Style {- End of Module Imports -} } $whitechar = [\ \t\n\r\f\v] $special = [\(\)\,\;\[\]\{\}] $ascdigit = 0-9 $unidigit = [] -- TODO $digit = [$ascdigit $unidigit] $ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] $unisymbol = [] -- TODO $symbol = [$ascsymbol $unisymbol] # [$special \_\:\"\'] $large = [A-Z \xc0-\xd6 \xd8-\xde] $small = [a-z \xdf-\xf6 \xf8-\xff \_] $alpha = [$small $large] $graphic = [$small $large $symbol $digit $special \:\"\'] $octit = 0-7 $hexit = [0-9 A-F a-f] $idchar = [$alpha $ascdigit] $nl = [\n\r] @importId = use | require @reservedId = if | while | do | then | last | next | redo | continue | goto | redo | for | foreach | unless | until | elsif | else | sub | package | our | my | defined | undef | exists | die | shift @seperator = $whitechar+ | $special @interpVarSeperator = [^$idchar] | $nl @reservedop = "->" | "*" | "+" | "-" | "%" | \\ | "||" | "&&" | "?" | ":" | "=>" | "or" | "xor" | "and" | "ne" | "eq" | "=~" | "!~" @preMatchRegexOp = @reservedop | "(" | "{" | "," -- Standard variables -- TODO: Handle casts of the form @varTypeOp{@varid} @varTypeOp = "@" | "$" | "%" @varPackageSpec = $idchar+ "::" @varIdentifier = @varPackageSpec* $idchar+ -- TODO: A lot! There is a whole list of special global variables. @specialVarIdentifier = "_" | ARG | "." | INPUT_LINE_NUMBER | NR | "?" | CHILD_ERROR | ENV -- TODO: The specialVarToken should have an entry like the following: -- | "/" | INPUT_RECORD_SEPARATOR | RS -- but that messes up the hacked together regex support. -- Standard classes @decimal = $digit+ @octal = $octit+ @hexadecimal = $hexit+ @exponent = [eE] [\-\+] @decimal -- string components $cntrl = [$large \@\[\\\]\^\_] @ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM | SUB | ESC | FS | GS | RS | US | SP | DEL -- The charesc set contains more than it really should. -- It currently tries to be the superset of all characters that are possible -- to escape in the various quoting modes. Problem is, the actual set of -- Characters that should be escapable in any quoting mode depends on the -- delimiter of the quoting mode and I haven't implemented such fanciness -- yet. $charesc = [abfnrtv\\\"\'\&\`\/] @escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal) @gap = \\ $whitechar+ \\ @nonInterpolatingString = $graphic # [\'] | " " @quoteLikeDelimiter = $special | $ascsymbol | \" | \' -- Heredoc @heredocId = $idchar+ -- Perldoc -- perldoc starts at a "line that begins with an equal sign and a word" -- (man perlsyn) @perlDocStartWord = "=" [^$whitechar]+ perlHighlighterRules :- <0> { -- Conditionalize on not being prefixed with a character that could -- indicate a regex-style quote. [^smqrty]^"#"[^\n]* { c commentStyle } ^"#"[^\n]* { c commentStyle } @seperator @reservedId / @seperator { c importStyle } @seperator @importId / @seperator { c keywordStyle } ^ @reservedId / @seperator { c importStyle } ^ @importId / @seperator { c keywordStyle } @varTypeOp { m (\s -> HlInVariable 0 s) (const $ withFg darkcyan) } @reservedop { c operatorStyle } @decimal | 0[oO] @octal | 0[xX] @hexadecimal { c numberStyle } @decimal \. @decimal @exponent? | @decimal @exponent { c numberStyle } -- Chunks that are handled as interpolating strings. \" { m (const $ HlInInterpString False "\"" ) operatorStyle } "`" { m (const $ HlInInterpString False "`" ) operatorStyle } -- Matching regex quote-like operators are also kinda like interpolating strings. -- In order to prevent a / delimited regex quote from being confused with -- division this only matches in the case the / is preeceded with the usual -- context I use it. ^($white*)"/" { m (const $ HlInInterpString True "/" ) operatorStyle } (@preMatchRegexOp $whitechar* "/") { m (const $ HlInInterpString True "/" ) operatorStyle } -- "?" -- { -- m (const $ HlInInterpString True "?" ) operatorStyle -- } "m/" { \str _ -> (HlInInterpString True "/", operatorStyle) } "s/" { \str _ -> (HlInSubstRegex "/", operatorStyle) } "m#" { \str _ -> (HlInInterpString True "#", operatorStyle) } "s#" { \str _ -> (HlInSubstRegex "#", operatorStyle) } -- In order to handle the various interpolation forms of a heredoc the lexer transitions to a -- state devoted to just collecting the heredoc identifier. "<<" { \str _ -> (HlStartCollectHeredocIdent, operatorStyle) } -- Chunks that are handles as non-interpolating strings. \' { m (const $ HlInString '\'') operatorStyle } "qw" @quoteLikeDelimiter { \str _ -> let startChar = head $ drop 2 $ fmap snd str closeChar '(' = ')' closeChar '{' = '}' closeChar '<' = '>' closeChar '[' = ']' closeChar c = c in (HlInString (closeChar startChar), operatorStyle) } -- perldoc starts at a "line that begins with an equal sign and a word" -- (man perlsyn) ^ @perlDocStartWord { m (const $ HlInPerldoc) commentStyle } -- Everything else is unstyled. $white { c defaultStyle } . { c defaultStyle } } { @escape { c defaultStyle } $white+ { c defaultStyle } -- Prevent $ at the end of a regex quote from being recognized as a -- variable. "$"/ { \state _ _ postInput -> case state of HlInInterpString True end_tag -> let postText = take (length end_tag) $ alexCollectChar postInput in if (postText == end_tag) then True else False HlInSubstRegex end_tag -> let postText = take (length end_tag) $ alexCollectChar postInput in if (postText == end_tag) then True else False _ -> False } { c stringStyle } @varTypeOp { m (\s -> HlInVariable 0 s) (const $ withFg darkcyan) } ./ { \state preInput _ _ -> case state of HlInInterpString _ end_tag -> let inputText = take (length end_tag) $ alexCollectChar preInput in if (inputText == end_tag) then True else False HlInSubstRegex end_tag -> let inputText = take (length end_tag) $ alexCollectChar preInput in if (inputText == end_tag) then True else False _ -> False } { m fromQuoteState operatorStyle } . { c stringStyle } } -- The << operator can be followed by -- Any number of spaces up to a ' or ". In which case the identifier is the sequence of characters -- collected until the matching quote. The heredoc is then processed in an interpolating context if -- the delimiter was " and a non-interpolating context if the delimiter was ' -- Any number of spaces followed by a non-quote and non-identifier character indicates the start of -- a heredoc with an empty line as the identifier. -- An identifier character following the << operator is the start of a heredoc identifier to be -- processed in an interpolating context. { $white { c defaultStyle } \' { m (const $ HlCollectHeredocIdent "" (Just '\'')) operatorStyle } \" { m (const $ HlCollectHeredocIdent "" (Just '\"')) operatorStyle } @heredocId { \indexedStr _ -> ( HlCollectHeredocIdent (fmap snd indexedStr) Nothing , variableStyle ) } . { m (const $ HlInInterpHeredocNoIdent) stringStyle } -- Although any HEREDOC identifier followed immediately by a newline is likely a syntax error we should still recognize them as -- HEREDOCs. \n { m (const $ HlInInterpHeredocNoIdent) stringStyle } } -- A heredoc identifier is collected until: -- If there is no defined deliminating quote then the next non-identifier character -- If there is a defined deliminating quote then the next character matching the specified -- character. -- TODO: Nested heredoc declarations { @heredocId { \indexedStr (HlCollectHeredocIdent ident delim) -> ( HlCollectHeredocIdent (ident ++ fmap snd indexedStr) delim , variableStyle ) } . { \indexedStr state -> let c = head $ fmap snd indexedStr in case state of HlCollectHeredocIdent ident Nothing -> (HlInInterpHeredoc ident, stringStyle) HlCollectHeredocIdent ident (Just '\'') | c == '\'' -> (HlInHeredoc ident, operatorStyle) | otherwise -> (HlCollectHeredocIdent ident (Just '\''), variableStyle) HlCollectHeredocIdent ident (Just '"') | c == '"' -> (HlInInterpHeredoc ident, operatorStyle) | otherwise -> (HlCollectHeredocIdent ident (Just '"'), variableStyle) } -- Although any HEREDOC identifier followed immediately by a newline is likely a syntax error we should still recognize them as -- HEREDOCs. \n { \indexedStr state -> let c = head $ fmap snd indexedStr in case state of HlCollectHeredocIdent ident Nothing -> (HlInInterpHeredoc ident, stringStyle) HlCollectHeredocIdent ident (Just '\'') | c == '\'' -> (HlInHeredoc ident, operatorStyle) | otherwise -> (HlCollectHeredocIdent ident (Just '\''), variableStyle) HlCollectHeredocIdent ident (Just '"') | c == '"' -> (HlInInterpHeredoc ident, operatorStyle) | otherwise -> (HlCollectHeredocIdent ident (Just '"'), variableStyle) } } { \n\n { m fromQuoteState defaultStyle } $white { c defaultStyle } @varTypeOp { m (\s -> HlInVariable 0 s) (const $ withFg darkcyan) } . { c stringStyle } } { ^(@heredocId\n)/ { \state preInput _ _ -> case state of HlInInterpHeredoc tag -> let inputText = take (length tag) $ alexCollectChar preInput in if (inputText == tag) then True else False _ -> False } { m fromQuoteState operatorStyle } $white+ { c defaultStyle } @varTypeOp { m (\s -> HlInVariable 0 s) (const $ withFg darkcyan) } . { c stringStyle } } { ^(@heredocId\n)/ { \state preInput _ _ -> case state of HlInHeredoc tag -> let inputText = take (length tag) $ alexCollectChar preInput in if (inputText == tag) then True else False _ -> False } { m fromQuoteState operatorStyle } $white+ { c defaultStyle } . { c stringStyle } } { -- Support highlighting uses of the # to determine subscript of the last element. -- This isn't entirely correct as it'll accept $########foo. (@varTypeOp | "#") { c $ const (withFg darkcyan) } "{" { m increaseVarCastDepth $ const (withFg darkcyan) } "}" { m decreaseVarCastDepth $ const (withFg darkcyan) } @specialVarIdentifier { m exitVarIfZeroDepth $ const (withFg cyan) } @varIdentifier { m exitVarIfZeroDepth $ const (withFg darkcyan) } $white { m (\(HlInVariable _ s) -> s) defaultStyle } . { m (\(HlInVariable _ s) -> s) defaultStyle } } { ^ "=cut" { m fromQuoteState commentStyle } $white+ { c defaultStyle } . { c commentStyle } } { $white+ { c defaultStyle } ./ { \state preInput _ _ -> case state of HlInString endDelimiter -> let currentChar = head $ alexCollectChar preInput in if (currentChar == endDelimiter) then True else False _ -> False } { m fromQuoteState operatorStyle } . { c stringStyle } } { data HlState = HlInCode -- Boolean indicating if the interpolated quote is a regex and deliminator of quote. | HlInInterpString !Bool !String | HlInString !Char | HlStartCollectHeredocIdent | HlCollectHeredocIdent !String !(Maybe Char) | HlInInterpHeredoc !String | HlInInterpHeredocNoIdent | HlInHeredoc !String | HlInPerldoc | HlInSubstRegex !String -- Count of nested {} and the state to transition to once variable is done. | HlInVariable !Int !HlState deriving Show fromQuoteState (HlInSubstRegex s) = HlInInterpString True s fromQuoteState _ = HlInCode increaseVarCastDepth (HlInVariable n s) = HlInVariable (n + 1) s increaseVarCastDepth state = error "increaseVarCastDepth applied to non HlInVariable state" decreaseVarCastDepth (HlInVariable n s) | n <= 1 = s | otherwise = HlInVariable (n - 1) s decreaseVarCastDepth state = error "decreaseVarCastDepth applied to non HlInVariable state" exitVarIfZeroDepth (HlInVariable 0 s) = s exitVarIfZeroDepth s = s type Token = StyleName stateToInit HlInCode = 0 stateToInit (HlInInterpString _ _) = interpString stateToInit (HlInString _) = string stateToInit HlStartCollectHeredocIdent = startCollectHeredocIdent stateToInit (HlCollectHeredocIdent _ _) = collectHeredocIdent stateToInit (HlInInterpHeredoc _) = interpHeredoc stateToInit HlInInterpHeredocNoIdent = interpHeredocNoIdent stateToInit (HlInHeredoc _) = heredoc stateToInit HlInPerldoc = perldoc stateToInit (HlInSubstRegex _) = interpString stateToInit (HlInVariable _ _) = variable initState :: HlState initState = HlInCode lexer :: StyleLexerASI HlState Token lexer = StyleLexer { _tokenToStyle = id , _styleLexer = commonLexer alexScanToken initState } #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Lexer/Python.x0000644000000000000000000001066613246272742016370 0ustar0000000000000000-- -*- haskell -*- -- -- A poorly-written Python lexer -- -- This is one of the first lexers I've ever written, so this could probably be -- rewritten much, much better. { #define NO_ALEX_CONTEXTS {-# OPTIONS -w #-} module Yi.Lexer.Python ( lexer ) where import Yi.Lexer.Alex hiding (tokenToStyle) import qualified Yi.Syntax import Yi.Style } $whitechar = [\ \t\n\r\f\v] $special = [\(\)\,\;\[\]\`\{\}\:] $ascdigit = 0-9 $unidigit = [] -- TODO $digit = [$ascdigit $unidigit] $ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] $unisymbol = [] -- TODO $symbol = [$ascsymbol $unisymbol] # [$special \_] $large = [A-Z \xc0-\xd6 \xd8-\xde] $small = [a-z \xdf-\xf6 \xf8-\xff \_] $alpha = [$small $large] $graphic = [$small $large $symbol $digit $special \"\'] $nonzerodigit = 1-9 $octit = 0-7 $hexit = [0-9 A-F a-f] $idchar = [$alpha $digit] $symchar = [$symbol] $nl = [\n\r] $strprefix = [urUR] $longintegersuffix = [lL] @builtins = False | None | True @importst = import @reservedid = @builtins | and | as | assert | break | class | continue | def | del | elif | else | except | exec | finally | for | from | global | if | in | is | lambda | not | or | pass | print | raise | return | try | while | with | yield @compop = "<=" | ">=" | "==" | "<" | ">" | "<>" @infarithop = "+" | "-" | "*" | "/" | "//" | "%" | "&" | "|" | "^" | ">>" | "<<" | "**" -- This is separated so the infix operators above can be used with the augmented assignment form" @prefarithop = "~" @assignop = @infarithop? "=" @reservedop = @compop | @prefarithop | @assignop @varid = $alpha $idchar* @varsym = $symbol+ @digits = $nonzerodigit $digit* @octits = "0" $octit @hexits = "0x" $hexit @integer = @digits | @octits | @hexits @longinteger = @integer $longintegersuffix @exponent = [eE] [\-\+] @integer @number = @integer | @longinteger $cntrl = [$large \@\[\\\]\^\_] main :- <0> { $white+ { c defaultStyle } "#"[^\n]* { c commentStyle } $special { c defaultStyle } @importst { c importStyle } @reservedid { c keywordStyle } @varid { c defaultStyle } @reservedop { c operatorStyle } -- @varsym { c operatorStyle } @number @exponent? | @number \. @number? @exponent? { c numberStyle } $strprefix* \" { m (const DoubleQuotes) stringStyle } $strprefix* \' { m (const SingleQuotes) stringStyle } $strprefix* \" \" \" { m (const DoubleDoc) stringStyle } $strprefix* \' \' \' { m (const SingleDoc) stringStyle } . { c operatorStyle } } { \" { m (const Base) stringStyle } . { c stringStyle } } { \' { m (const Base) stringStyle } . { c stringStyle } } { \"\"\" { m (const Base) stringStyle } $white+ ; -- whitespace [^\"]+ { c stringStyle } . { c stringStyle } } { \'\'\' { m (const Base) stringStyle } $white+ ; -- whitespace [^\']+ { c stringStyle } . { c stringStyle } } { data HlState = Base | DoubleQuotes | SingleQuotes | DoubleDoc | SingleDoc deriving (Eq, Show) type Token = StyleName stateToInit Base = 0 stateToInit DoubleQuotes = doublequotes stateToInit SingleQuotes = singlequotes stateToInit DoubleDoc = doubledoc stateToInit SingleDoc = singledoc initState :: HlState initState = Base lexer :: StyleLexerASI HlState Token lexer = StyleLexer { _tokenToStyle = id , _styleLexer = commonLexer alexScanToken initState } #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Lexer/R.x0000644000000000000000000002207113226661437015302 0ustar0000000000000000-- -*- haskell -*- -- -- A poorly-written R lang lexer -- -- This is one of the first lexers I've ever written, so this could probably be -- rewritten much, much better. { #define NO_ALEX_CONTEXTS {-# OPTIONS -w #-} -- Alex generate warnings-ridden code. module Yi.Lexer.R ( lexer ) where {- Standard Library Modules Imported -} import Yi.Lexer.Alex hiding (tokenToStyle) {- External Library Modules Imported -} {- Local Modules Imported -} import qualified Yi.Syntax import Yi.Style } $whitechar = [\ \t\n\r\f\v] $special = [\(\)\,\;\[\]\`\{\}] $ascdigit = 0-9 $unidigit = [] -- TODO $digit = [$ascdigit $unidigit] $ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] $unisymbol = [] -- TODO $symbol = [$ascsymbol $unisymbol] # [$special \_\:\"\'] $large = [A-Z \xc0-\xd6 \xd8-\xde] $small = [a-z \xdf-\xf6 \xf8-\xff \_] $alpha = [$small $large] $graphic = [$small $large $symbol $digit $special \:\"\'] $octit = 0-7 $hexit = [0-9 A-F a-f] $idchar = [$alpha $digit \'] $symchar = [$symbol \:] $nl = [\n\r] @reservedid = auto | read | csv | delim | fwf | save | image | cat | str | help | ls | methods | format | write | table | sink | c | seq | rep | data | frame | list | arary | matrix | factor | gl | rbind | cbind | as | is | null | na | arary | dim | dimnames | nrow | ncol | class | unclass | attr | attributes | which | max | min | rev | sort | cut | match | which | choose | omit | fail | unique | table | subset | sample | sin | cos | tan | asin | acos | atan | atan2 | log | log10 | exp | range | sum | diff | prod | mean | median | quantile | weighted | rank | var | sd | cor | round | log | scale | pmin | pmax | cumsum | cumprod | cummin | union | Re | Im | Mod | Arg | Conj | Convolve | fft | mvfft | filter | t | diag | solve | rowsum | colsum | rowMeans | colMeans | apply | lapply | tapply | by | merge | xtabs | aggregate | stack | unstack | reshape | paste | substr | strsplit | grep | gsub | tolower | toupper | match | pmatch | nchar | Date | POSIXct | difftime | plot | hist | barplot | dotchart | pie | boxplot | sunflowerplot | stripplot | coplot | interaction | matplot | fourfoldprot | assocplot | mosaicplot | pairs | ts | qqnorm | qqplot | contour | filled | image | persp | stars | symbols | termplot | FALSE | TRUE | xlim | ylim | xlab | ylab | main | points | lines | text | mtext | segments | arrows | abline | rect | polygon | legend | title | axis | rug | locator | adj | bg | cex | col | font | las | lty | lwd | mar | mfcol | mfrow | pch | ps | ptf | tck | tcl | xaxt | yaxt | xyplot | barchat | dotplot | densityplot | histogram | bwplot | qqmath | stripplot | qq | splom | parallel | levelplot | wireframe | cloud | optim | nlm | lm | glm | nls | approx | spline | loess | predict | df | residual | coef | residuals | deviance | fitted | logLik | AIC | aov | anova | density | binom | test | pairwise | power | prop | search | rnorm | rexp | rgamma | rpois | rweibull | rcauchy | rbeta | rt | rf | rchisq | rbinom | rgeom | rhyper | rlogis | rlnorm | rnbinom | runif | rwilcox | function | return | if | for | while | repeat | break | next | ifelse | do | call | case | char | continue | default | else | switch | union @reservedop = "%*%" | "%in%" | "+" | "++" | "+=" | "-" | "--" | "-=" | "*" | "*=" | "/" | "/=" | "%" | "%=" | "<" | "<=" | ">" | ">=" | "!=" | "==" | "!" | "&&" | "||" | "<<" | "<<=" | ">>" | ">>=" | "~" | "&" | "&=" | "|" | "|=" | "^" | "^=" | "=" | "->" | "." | "," | "?" | ":" | "sizeof" @varid = $small $idchar* @conid = $large $idchar* @varsym = $symbol $symchar* @consym = \: $symchar* @decimal = $digit+ @octal = $octit+ @hexadecimal = $hexit+ @exponent = [eE] [\-\+] @decimal $cntrl = [$large \@\[\\\]\^\_] @ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM | SUB | ESC | FS | GS | RS | US | SP | DEL $charesc = [abfnrtv\\\"\'\&] @escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal) @gap = \\ $whitechar+ \\ @string = $graphic # [\"\\] | " " | @escape | @gap c :- <0> $white+ { c defaultStyle } -- whitespace { -- We could do nested comments like this -- "/*" { m (subtract 1) blockCommentStyle } "*/" { m (+1) blockCommentStyle } $white+ ; -- Whitespace . { c blockCommentStyle } } <0> { "//"[^\n]* { c commentStyle } "/*".*"*/" { c blockCommentStyle } "/*" @reservedop* { m (subtract 1) blockCommentStyle } $special { c defaultStyle } @reservedid { c keywordStyle } @varid { c defaultStyle } @conid { c typeStyle } @reservedop { c operatorStyle } @varsym { c operatorStyle } @consym { c typeStyle } @decimal | 0[oO] @octal | 0[xX] @hexadecimal { c defaultStyle } @decimal \. @decimal @exponent? | @decimal @exponent { c defaultStyle } \' ($graphic # [\'\\] | " " | @escape) \' { c stringStyle } \" @string* \" { c stringStyle } . { c operatorStyle } } { type HlState = Int type Token = StyleName lexer :: StyleLexerASI HlState Token lexer = StyleLexer { _tokenToStyle = id , _styleLexer = commonLexer alexScanToken initState } stateToInit :: HlState -> Int stateToInit x | x < 0 = nestcomm | otherwise = 0 initState :: HlState initState = 0 #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Lexer/Ruby.x0000644000000000000000000001034013306254265016012 0ustar0000000000000000-- -*- haskell -*- -- -- A Ruby lexer -- -- This is based on the Python lexer. { #define NO_ALEX_CONTEXTS {-# OPTIONS -w #-} module Yi.Lexer.Ruby ( lexer ) where import Yi.Lexer.Alex hiding (tokenToStyle) import qualified Yi.Syntax import Yi.Style } $whitechar = [\ \t\n\r\f\v] $special = [\(\)\,\;\[\]\`\{\}\:] $ascdigit = 0-9 $unidigit = [] -- TODO $digit = [$ascdigit $unidigit] $ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] $unisymbol = [] -- TODO $symbol = [$ascsymbol $unisymbol] # [$special \_] $large = [A-Z \xc0-\xd6 \xd8-\xde] $small = [a-z \xdf-\xf6 \xf8-\xff \_] $alpha = [$small $large] $graphic = [$small $large $symbol $digit $special \"\'] $nonzerodigit = 1-9 $octit = 0-7 $hexit = [0-9 A-F a-f] $idchar = [$alpha $digit] $symchar = [$symbol] $nl = [\n\r] $longintegersuffix = [lL] @builtinValues = true | false | nil | self @builtinVars = deferr | defout | stderr | stdin | stdout | DEBUG | FILENAME | KCODE | LOADED_FEATURES | LOAD_PATH | PROGRAM_NAME | SAFE | VERBOSE -- @builtinConstants = @importst = import | include | require | require_relative @reservedid = @builtinVars | abort | and | alias | assert | begin | break | case | class | continue | def | do | elsif | else | end | ensure | except | exec | exit | for | fork | from | gets | global | if | in | lambda | loop | next | not | or | pass | print | puts | raise | redo | rescue | retry | return | super | trap | try | undef | unless | until | when | while | with | yield @compop = "<=" | ">=" | "==" | "<" | ">" | "<>" @infarithop = "+" | "-" | "*" | "/" | "//" | "%" | "&" | "|" | "^" | ">>" | "<<" | "**" -- This is separated so the infix operators above can be used with the augmented assignment form" @prefarithop = "~" @assignop = @infarithop? "=" @reservedop = @compop | @prefarithop | @assignop @varid = $alpha $idchar* @varsym = $symbol+ @digits = $nonzerodigit $digit* @octits = "0" $octit @hexits = "0x" $hexit @integer = @digits | @octits | @hexits @longinteger = @integer $longintegersuffix @exponent = [eE] [\-\+] @integer @number = @integer | @longinteger @predicates = $small* \? $cntrl = [$large \@\[\\\]\^\_] @ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM | SUB | ESC | FS | GS | RS | US | SP | DEL $charesc = [abfnrtv\\\"\'\&] @escape = \\ ($charesc | @ascii | @number) @gap = \\ $whitechar+ \\ @shortstring = $graphic # [\"\'\\] | " " | @escape | @gap @longstring = @shortstring | $nl main :- <0> { $white+ { c defaultStyle } "#"[^\n]* { c commentStyle } $special { c defaultStyle } @importst { c importStyle } @reservedid { c keywordStyle } @builtinValues { c typeStyle } @predicates { c operatorStyle } -- classes and modules [A-Z] $alpha* { c builtinStyle } @varid { c variableStyle } @reservedop { c operatorStyle } @number @exponent? | @number \. @number? @exponent? { c numberStyle } -- symbols and raw strings :[$small $large _]+ { c stringStyle } \%q\{ @longstring* \} | \' @shortstring* \' { c stringStyle } -- interpolated strings \%\{ @longstring* \} | \%\/ @longstring* \/ | \%Q\{ @longstring* \} | \" @shortstring* \" { c stringStyle } . { c operatorStyle } } { type HlState = Int type Token = StyleName stateToInit x = 0 initState :: HlState initState = 0 lexer :: StyleLexerASI HlState Token lexer = StyleLexer { _tokenToStyle = id , _styleLexer = commonLexer alexScanToken initState } #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Lexer/SVNCommit.x0000644000000000000000000000203513226661437016716 0ustar0000000000000000-- -*- haskell -*- -- Maintainer: Corey O'Connor { #define NO_ALEX_CONTEXTS {-# OPTIONS -w #-} module Yi.Lexer.SVNCommit ( lexer ) where import Yi.Lexer.Alex hiding (tokenToStyle) import Yi.Style ( Style ( .. ) , StyleName ) import qualified Yi.Style as Style } @changeType = [^$white]+$white* svnCommitMessage :- <0> { ^"--".*"--"$ { m (const $ HlCommitSummary) Style.commentStyle } $white { c Style.defaultStyle } . { c Style.defaultStyle } } { ^@changeType { c Style.keywordStyle } $white { c Style.commentStyle } . { c Style.commentStyle } } { data HlState = HlCommitMessage | HlCommitSummary deriving (Show) stateToInit HlCommitMessage = 0 stateToInit HlCommitSummary = commitSummary initState :: HlState initState = HlCommitMessage type Token = StyleName lexer :: StyleLexerASI HlState Token lexer = StyleLexer { _tokenToStyle = id , _styleLexer = commonLexer alexScanToken initState } #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Lexer/Srmc.x0000644000000000000000000000640413226661437016007 0ustar0000000000000000-- -*- haskell -*- -- -- Simple syntax highlighting for srmc source. -- Also to be used for pepa source files since pepa -- is a subset of srmc. -- I also believe that this makes a reasonable example -- for new syntax files -- { #define NO_ALEX_CONTEXTS {-# OPTIONS -w #-} module Yi.Lexer.Srmc ( lexer ) where {- Local Modules Imported -} import Yi.Lexer.Alex hiding (tokenToStyle) import qualified Yi.Syntax import Yi.Style ( Style ( .. ) , defaultStyle , commentStyle , blockCommentStyle , keywordStyle , operatorStyle , typeStyle , stringStyle , numberStyle , StyleName ) {- End of Module Imports -} } $whitechar = [\ \t\n\r\f\v] $special = [\(\)\,\;\[\]\`\{\}] $ascdigit = 0-9 $unidigit = [] -- TODO $digit = [$ascdigit $unidigit] $ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] $unisymbol = [] -- TODO $pepasymbol = [\;\.\,\+=\<\>] $symbol = [$pepasymbol] $large = [A-Z \xc0-\xd6 \xd8-\xde] $small = [a-z \xdf-\xf6 \xf8-\xff \_] $alpha = [$small $large] $graphic = [$small $large $symbol $digit $special \:\"\'] $octit = 0-7 $hexit = [0-9 A-F a-f] $idchar = [$alpha $digit \'] $symchar = [$symbol] $nl = [\n\r] @reservedid = Stop|infty @reservedop = "&&" | "||" @varid = $small $idchar* @conid = $large $idchar* @varsym = $symbol $symchar* @consym = \: $symchar* @decimal = $digit+ @double = $digit+ \. $digit+ @octal = $octit+ @hexadecimal = $hexit+ @exponent = [eE] [\-\+] @decimal $cntrl = [$large \@\[\\\]\^\_] @ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM | SUB | ESC | FS | GS | RS | US | SP | DEL $charesc = [abfnrtv\\\"\'\&] @escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal) @gap = \\ $whitechar+ \\ @string = $graphic # [\"\\] | " " | @escape | @gap haskell :- <0> $white+ { c defaultStyle } -- whitespace <0> { "%"\-*[^\n]* { c commentStyle } "//"\-*[^\n]* { c commentStyle } -- $special { c defaultStyle } @reservedid { c keywordStyle } @varid { c stringStyle } @conid { c typeStyle } @reservedop { c operatorStyle } @varsym { c operatorStyle } @decimal | @double | 0[oO] @octal | 0[xX] @hexadecimal { c numberStyle } @decimal \. @decimal @exponent? | @decimal @exponent { c defaultStyle } . { c defaultStyle } \" @string* \" { c keywordStyle } } { type HlState = Int type Token = StyleName {- See Haskell.x which uses this to say whether we are in a comment (perhaps a nested comment) or not. -} stateToInit x = 0 initState :: HlState initState = 0 lexer :: StyleLexerASI HlState Token lexer = StyleLexer { _tokenToStyle = id , _styleLexer = commonLexer alexScanToken initState } #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Lexer/Whitespace.x0000644000000000000000000000145113226661437017174 0ustar0000000000000000-- -*- haskell -*- -- Lexer for Whitespace -- (C) Copyright 2009 Deniz Dogan (mad credz) { #define NO_ALEX_CONTEXTS {-# OPTIONS -w #-} module Yi.Lexer.Whitespace ( lexer ) where import Yi.Lexer.Alex hiding (tokenToStyle) import Yi.Style (StyleName, withBg, red, green, commentStyle) } @space = " " @tab = \t @nl = [\r\n] :- <0> { @space+ { c spaceStyle } @tab+ { c tabStyle } @nl ; . { c commentStyle } } { spaceStyle :: StyleName spaceStyle = const $ withBg red tabStyle :: StyleName tabStyle = const $ withBg green type Token = StyleName type HlState = Int stateToInit x = 0 initState :: HlState initState = 0 lexer :: StyleLexerASI HlState Token lexer = StyleLexer { _tokenToStyle = id , _styleLexer = commonLexer alexScanToken initState } #include "common.hsinc" } yi-misc-modes-0.18.0/src/Yi/Syntax/Latex.hs0000644000000000000000000001264213226661437016533 0ustar0000000000000000{-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- uniplate patterns {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Syntax.Latex -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Parser used by the LaTeX modes. module Yi.Syntax.Latex where import Control.Applicative (Alternative ((<|>), empty, many)) import Data.Monoid (Endo (..), (<>)) import Yi.IncrementalParse (P, eof, recoverWith, symbol) import Yi.Lexer.Alex hiding (tokenToStyle) import Yi.Lexer.Latex (Token (..), tokenToText) import Yi.Style import Yi.Syntax (Point, Span) import Yi.Syntax.Tree (IsTree (emptyNode, uniplate)) isNoise :: Token -> Bool isNoise Text = True isNoise Comment = True isNoise (Command _) = True isNoise NewCommand = True isNoise (Special ' ') = True isNoise (Special _) = False isNoise (Begin _) = False isNoise (End _) = False type TT = Tok Token type Expr t = [Tree t] data Tree t = Paren t (Tree t) t -- A parenthesized expression (maybe with [ ] ...) | Atom t | Error t | Expr (Expr t) deriving (Show, Functor, Foldable) instance IsTree Tree where uniplate (Paren l g r) = ([g], \[g'] -> Paren l g' r) uniplate (Expr g) = (g, Expr) uniplate t = ([],const t) emptyNode = Expr [] parse :: P TT (Tree TT) parse = pExpr True <* eof where -- Create a special character symbol newT c = tokFromT (Special c) -- errT = (\next -> case next of -- Nothing -> newT '!' -- Just (Tok {tokPosn = posn}) -> Tok { tokT = Special '!', tokPosn = posn-1, tokSize = 1 -- FIXME: size should be 1 char, not one byte! -- }) <$> lookNext errT = pure (newT '!') -- parse a special symbol sym' p = symbol (p . tokT) sym t = sym' (== t) pleaseSym c = recoverWith errT <|> sym c -- pleaseSym' c = recoverWith errT <|> sym' c -- pExpr :: P TT [Expr TT] pExpr outsideMath = Expr <$> many (pTree outsideMath) parens = [(Special x, Special y) | (x,y) <- zip "({[" ")}]"] openParens = fmap fst parens pBlock = sym' isBegin >>= \beg@Tok {tokT = Begin env} -> Paren <$> pure beg <*> pExpr True <*> pleaseSym (End env) pTree :: Bool -> P TT (Tree TT) pTree outsideMath = (if outsideMath then pBlock <|> (Paren <$> sym (Special '$') <*> pExpr False <*> pleaseSym (Special '$')) else empty) <|> foldr1 (<|>) [Paren <$> sym l <*> pExpr outsideMath <*> pleaseSym r | (l,r) <- parens] <|> (Atom <$> sym' isNoise) <|> (Error <$> recoverWith (sym' (not . ((||) <$> isNoise <*> (`elem` openParens))))) getStrokes :: Point -> Point -> Point -> Tree TT -> [Stroke] getStrokes point _begin _end t0 = appEndo result [] where getStrokes' :: Tree TT -> Endo [Stroke] getStrokes' (Expr g) = getStrokesL g getStrokes' (Atom t) = ts id t getStrokes' (Error t) = ts (modStroke errorStyle) t -- paint in red getStrokes' (Paren l g r) -- we have special treatment for (Begin, End) because these blocks are typically very large. -- we don't force the "end" part to prevent parsing the whole file. | isBegin (tokT l) = if posnOfs (tokPosn l) /= point then normalPaint else case (tokT l, tokT r) of (Begin b, End e) | b == e -> hintPaint _ -> errPaint | isErrorTok (tokT r) = errPaint -- left paren wasn't matched: paint it in red. -- note that testing this on the "Paren" node actually forces the parsing of the -- right paren, undermining online behaviour. | posnOfs (tokPosn l) == point || posnOfs (tokPosn r) == point - 1 = hintPaint | otherwise = normalPaint where normalPaint = ts id l <> getStrokes' g <> tsEnd id l r hintPaint = ts (modStroke hintStyle) l <> getStrokes' g <> tsEnd (modStroke hintStyle) l r errPaint = ts (modStroke errorStyle) l <> getStrokes' g tsEnd _ (Tok{tokT = Begin b}) t@(Tok{tokT = End e}) | b /= e = ts (modStroke errorStyle) t tsEnd f _ t = ts f t getStrokesL :: Expr TT -> Endo [Stroke] getStrokesL = foldMap getStrokes' ts f t | isErrorTok (tokT t) = mempty | otherwise = Endo (f (tokenToStroke t) :) result = getStrokes' t0 modStroke :: StyleName -> Stroke -> Stroke modStroke f = fmap (f `mappend`) tokenToStroke :: TT -> Stroke tokenToStroke = fmap tokenToStyle . tokToSpan tokenToAnnot :: TT -> Maybe (Span String) tokenToAnnot = sequenceA . tokToSpan . fmap tokenToText tokenToStyle :: Token -> StyleName tokenToStyle t = case t of Comment -> commentStyle Text -> defaultStyle Special _ -> defaultStyle Command _ -> typeStyle Begin _ -> keywordStyle End _ -> keywordStyle NewCommand -> keywordStyle isSpecial :: String -> Token -> Bool isSpecial cs (Special c) = c `elem` cs isSpecial _ _ = False isBegin, isEnd :: Token -> Bool isBegin (Begin _) = True isBegin _ = False isEnd (End _) = True isEnd _ = False isErrorTok :: Token -> Bool isErrorTok = isSpecial "!" yi-misc-modes-0.18.0/src/Yi/Lexer/BasicTemplate.x0000644000000000000000000000077313246272742017622 0ustar0000000000000000-- -*- haskell -*- { #define NO_ALEX_CONTEXTS {-# OPTIONS -w #-} module Yi.Lexer.BasicTemplate ( initState, alexScanToken ) where import Yi.Lexer.Alex hiding (tokenToStyle) import Yi.Style ( Style ( .. ) , StyleName ) import qualified Yi.Style as Style } main :- <0> { $white { c Style.defaultStyle } . { c Style.defaultStyle } } { data HlState stateToInit _ = 0 initState :: HlState initState = undefined type Token = StyleName #include "common.hsinc" } yi-misc-modes-0.18.0/Setup.hs0000644000000000000000000000012613226661437014112 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main :: IO () main = defaultMain yi-misc-modes-0.18.0/yi-misc-modes.cabal0000644000000000000000000000302313326315410016104 0ustar0000000000000000name: yi-misc-modes version: 0.18.0 synopsis: Yi editor miscellaneous modes category: Yi homepage: https://github.com/yi-editor/yi#readme bug-reports: https://github.com/yi-editor/yi/issues maintainer: Yi developers license: GPL-2 build-type: Simple cabal-version: >= 1.10 extra-source-files: src/Yi/Lexer/common.hsinc source-repository head type: git location: https://github.com/yi-editor/yi library hs-source-dirs: src ghc-options: -Wall -ferror-spans include-dirs: src/Yi/Lexer build-depends: array , base >= 4.8 && < 5 , binary >= 0.7 , data-default , filepath , microlens-platform , text , yi-core >= 0.18 , yi-language >= 0.18 , yi-rope >= 0.10 build-tools: alex >= 3.0.3 && < 3.2.0 || >= 3.2.1 exposed-modules: Yi.Config.Default.MiscModes Yi.Modes Yi.Mode.Buffers Yi.Mode.Abella Yi.Mode.Latex Yi.Lexer.Abella Yi.Lexer.C Yi.Lexer.Cabal Yi.Lexer.Clojure Yi.Lexer.Cplusplus Yi.Lexer.GNUMake Yi.Lexer.GitCommit Yi.Lexer.JSON Yi.Lexer.Java Yi.Lexer.Latex Yi.Lexer.OCaml Yi.Lexer.ObjectiveC Yi.Lexer.Ott Yi.Lexer.Perl Yi.Lexer.Python Yi.Lexer.R Yi.Lexer.Ruby Yi.Lexer.SVNCommit Yi.Lexer.Srmc Yi.Lexer.Whitespace Yi.Syntax.Latex other-modules: Yi.Lexer.BasicTemplate Paths_yi_misc_modes default-language: Haskell2010 yi-misc-modes-0.18.0/src/Yi/Lexer/common.hsinc0000644000000000000000000000705013226661437017226 0ustar0000000000000000-- -*- Haskell -*- -- The include file for alex-generated syntax highlighters. Because alex -- declares its own types, any wrapper must have the highlighter in scope... -- so it must be included. Doubleplusyuck. #define IBOX(n) (I# (n)) #define GEQ_(x, y) (tagToEnum# (x >=# y)) #define EQ_(x, y) (tagToEnum# (x ==# y)) -- | Scan one token. Return (maybe) a token and a new state. alexScanToken :: (AlexState HlState, AlexInput) -> Maybe (Tok Token, (AlexState HlState, AlexInput)) alexScanToken (AlexState state lookedOfs pos, inp@(_prevCh,_bs,str)) = let (scn,lookahead) = alexScanUser' state inp (stateToInit state) lookedOfs' = max lookedOfs (posnOfs pos +~ Size lookahead) in case scn of AlexEOF -> Nothing AlexError inp' -> Nothing AlexSkip inp' len -> let chunk = take (fromIntegral len) str in alexScanToken (AlexState state lookedOfs' (moveStr pos chunk), inp') AlexToken inp' len act -> let (state', tokValue) = act chunk state chunk = take (fromIntegral len) str newPos = moveStr pos chunk in Just (Tok tokValue (posnOfs newPos ~- posnOfs pos) pos, (AlexState state' lookedOfs' newPos, inp')) alexScan' input (I# (sc)) = alexScanUser' undefined input (I# (sc)) alexScanUser' user input (I# (sc)) = case alex_scan_tkn' user input 0# input sc AlexNone of (AlexNone, input', lookahead) -> case alexGetByte input of Nothing -> (AlexEOF, lookahead) Just _ -> (AlexError input', lookahead) (AlexLastSkip input'' len, _, lookahead) -> (AlexSkip input'' len, lookahead) #if MIN_TOOL_VERSION_alex(3,2,0) (AlexLastAcc k input'' len, _, lookahead) -> (AlexToken input'' len (alex_actions ! k), lookahead) #else (AlexLastAcc k input'' len, _, lookahead) -> (AlexToken input'' len k, lookahead) #endif -- Same as alex_scan_tkn, but also return the length of lookahead. alex_scan_tkn' user orig_input len input s last_acc = input `seq` -- strict in the input let new_acc = check_accs (alex_accept `quickIndex` IBOX(s)) in new_acc `seq` case alexGetByte input of Nothing -> (new_acc, input, IBOX(len)) Just (c, new_input) -> let base = alexIndexInt32OffAddr alex_base s ord_c = case fromIntegral c of (I# x) -> x offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset new_s = if GEQ_(offset, 0#) && EQ_(check, ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s new_len = if c < 0x80 || c >= 0xC0 then len +# 1# else len in case new_s of -1# -> (new_acc, input, IBOX(new_len)) -- on an error, we want to keep the input *before* the -- character that failed, not after. -- (but still, we looked after) _ -> alex_scan_tkn' user orig_input new_len new_input new_s new_acc where check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input IBOX(len) check_accs (AlexAccSkip) = AlexLastSkip input IBOX(len) #ifndef NO_ALEX_CONTEXTS check_accs (AlexAccPred a predx rest) | predx user orig_input IBOX(len) input = AlexLastAcc a input IBOX(len) | otherwise = check_accs rest check_accs (AlexAccSkipPred predx rest) | predx user orig_input IBOX(len) input = AlexLastSkip input IBOX(len) | otherwise = check_accs rest #endif c = actionConst m = actionAndModify ms = actionStringAndModify cs = actionStringConst