module Yi.Modes (TokenBasedMode, fundamentalMode,
cMode, objectiveCMode, cppMode, cabalMode, clojureMode,
srmcMode, ocamlMode, ottMode, gnuMakeMode,
perlMode, pythonMode, javaMode, jsonMode, anyExtension,
extensionOrContentsMatch, linearSyntaxMode,
svnCommitMode, hookModes, applyModeHooks,
lookupMode, whitespaceMode,
gitCommitMode, rubyMode, styleMode
) where
import Control.Applicative ((<$>))
import Control.Lens ((%~), (&), (.~), (^.))
import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe, isJust)
import System.FilePath (takeDirectory, takeExtension, takeFileName)
import qualified Data.Text as T (Text)
import qualified Data.Text.ICU as ICU (regex, find, MatchOption(..))
import Yi.Buffer
import qualified Yi.IncrementalParse as IncrParser (scanner)
import Yi.Keymap (YiM)
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.MiniBuffer (anyModeByNameM)
import qualified Yi.Rope as R (YiString, toText)
import Yi.Search (makeSimpleSearch)
import Yi.Style (StyleName)
import Yi.Syntax (ExtHL (ExtHL))
import Yi.Syntax.Driver (mkHighlighter)
import Yi.Syntax.OnlineTree (Tree, manyToks)
import Yi.Syntax.Tree (tokenBasedStrokes)
type TokenBasedMode tok = Mode (Tree (Tok tok))
type StyleBasedMode = TokenBasedMode StyleName
fundamentalMode :: Mode syntax
fundamentalMode = emptyMode
{ modeName = "fundamental"
, modeApplies = modeAlwaysApplies
, modeIndent = const autoIndentB
, modePrettify = const fillParagraph
, modeGotoDeclaration = do
currentPoint <- pointB
currentWord <- readCurrentWordB
currentWordBeginningPoint <- regionStart <$> regionOfB unitWord
_ <- gotoLn 0
word <- return $ makeSimpleSearch currentWord
searchResults <- regexB Forward word
case searchResults of
(declarationRegion : _) -> do
searchPoint <- return $ regionStart declarationRegion
if currentWordBeginningPoint /= searchPoint
then moveTo searchPoint
else moveTo currentPoint
[] -> moveTo currentPoint
}
linearSyntaxMode' :: Show (l s)
=> Lexer l s (Tok t) i
-> (t -> StyleName)
-> TokenBasedMode t
linearSyntaxMode' scanToken tts = fundamentalMode
& modeHLA .~ ExtHL (mkHighlighter $ IncrParser.scanner manyToks . lexer)
& modeGetStrokesA .~ tokenBasedStrokes tokenToStroke
where
tokenToStroke = fmap tts . tokToSpan
lexer = lexScanner scanToken
linearSyntaxMode :: Show s => s
-> TokenLexer AlexState s (Tok t) AlexInput
-> (t -> StyleName)
-> TokenBasedMode t
linearSyntaxMode initSt scanToken =
linearSyntaxMode' (commonLexer scanToken initSt)
styleMode :: Show (l s) => StyleLexer l s t i
-> TokenBasedMode t
styleMode l = linearSyntaxMode' (l ^. styleLexer) (l ^. tokenToStyle)
cMode :: StyleBasedMode
cMode = styleMode C.lexer
& modeNameA .~ "c"
& modeAppliesA .~ anyExtension [ "c", "h" ]
objectiveCMode :: StyleBasedMode
objectiveCMode = styleMode ObjectiveC.lexer
& modeNameA .~ "objective-c"
& modeAppliesA .~ anyExtension [ "m", "mm" ]
cppMode :: StyleBasedMode
cppMode = styleMode Cplusplus.lexer
& modeAppliesA .~ anyExtension [ "cxx", "cpp", "hxx" ]
& modeNameA .~ "c++"
cabalMode :: StyleBasedMode
cabalMode = styleMode Cabal.lexer
& modeNameA .~ "cabal"
& modeAppliesA .~ anyExtension [ "cabal" ]
& modeToggleCommentSelectionA .~ Just (toggleCommentB "--")
clojureMode :: StyleBasedMode
clojureMode = styleMode Clojure.lexer
& modeNameA .~ "clojure"
& modeAppliesA .~ anyExtension [ "clj", "edn" ]
srmcMode :: StyleBasedMode
srmcMode = styleMode Srmc.lexer
& modeNameA .~ "srmc"
& modeAppliesA .~ anyExtension [ "pepa", "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 :: StyleBasedMode
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 :: StyleBasedMode
perlMode = styleMode Perl.lexer
& modeNameA .~ "perl"
& modeAppliesA .~ anyExtension [ "t", "pl", "pm" ]
rubyMode :: StyleBasedMode
rubyMode = styleMode Ruby.lexer
& modeNameA .~ "ruby"
& modeAppliesA .~ anyExtension [ "rb", "ru" ]
pythonMode :: StyleBasedMode
pythonMode = base
& modeNameA .~ "python"
& modeAppliesA .~ anyExtension [ "py" ]
& modeToggleCommentSelectionA .~ Just (toggleCommentB "#")
& modeIndentSettingsA %~ (\x -> x { expandTabs = True, tabSize = 4 })
where
base = styleMode Python.lexer
javaMode :: StyleBasedMode
javaMode = styleMode Java.lexer
& modeNameA .~ "java"
& modeAppliesA .~ anyExtension [ "java" ]
jsonMode :: StyleBasedMode
jsonMode = styleMode JSON.lexer
& modeNameA .~ "json"
& modeAppliesA .~ anyExtension [ "json" ]
gnuMakeMode :: StyleBasedMode
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 :: StyleBasedMode
ottMode = styleMode Ott.lexer
& modeNameA .~ "ott"
& modeAppliesA .~ anyExtension [ "ott" ]
whitespaceMode :: StyleBasedMode
whitespaceMode = styleMode Whitespace.lexer
& modeNameA .~ "whitespace"
& modeAppliesA .~ anyExtension [ "ws" ]
& modeIndentA .~ (\_ _ -> insertB '\t')
extensionMatches :: [String]
-> FilePath
-> Bool
extensionMatches extensions fileName = extension `elem` extensions'
where extension = takeExtension fileName
extensions' = ['.' : ext | ext <- extensions]
anyExtension :: [String]
-> FilePath
-> a
-> Bool
anyExtension extensions fileName _contents
= extensionMatches extensions fileName
extensionOrContentsMatch :: [String] -> T.Text -> FilePath -> R.YiString -> Bool
extensionOrContentsMatch extensions pattern fileName contents
= extensionMatches extensions fileName || isJust m
where
r = ICU.regex [] pattern
m = ICU.find r $ R.toText contents
hookModes :: (AnyMode -> Bool) -> BufferM () -> [AnyMode] -> [AnyMode]
hookModes p h = map $ \am@(AnyMode m) ->
if p am then AnyMode (m & modeOnLoadA %~ (>> h)) else am
applyModeHooks :: [(AnyMode -> Bool, BufferM ())] -> [AnyMode] -> [AnyMode]
applyModeHooks hs ms = flip map ms $ \am -> case filter (($ am) . fst) hs of
[] -> am
ls -> onMode (modeOnLoadA %~ \x -> foldr ((>>) . snd) x ls) am
lookupMode :: AnyMode -> YiM AnyMode
lookupMode am@(AnyMode m) = fromMaybe am <$> anyModeByNameM (modeName m)