module Yi.Keymap.Vim.InsertMap (defInsertMap) where
import Control.Applicative
import Control.Lens
import Control.Monad
import Data.Char (isDigit)
import Data.List.NonEmpty hiding (drop, span, dropWhile)
import Data.Monoid
import qualified Data.Text as T
import Prelude hiding (head)
import qualified Yi.Buffer as B
import Yi.Buffer.Adjusted as BA hiding (Insert)
import Yi.Editor
import Yi.Event
import Yi.Keymap.Vim.Common
import Yi.Keymap.Vim.Digraph
import Yi.Keymap.Vim.EventUtils
import Yi.Keymap.Vim.Motion
import Yi.Keymap.Vim.StateUtils
import Yi.Keymap.Vim.Utils
import Yi.Monad
import qualified Yi.Rope as R
import Yi.TextCompletion (completeWordB, CompletionScope(..))
defInsertMap :: [(String, Char)] -> [VimBinding]
defInsertMap digraphs =
[rawPrintable] <> specials digraphs <> [printable]
specials :: [(String, Char)] -> [VimBinding]
specials digraphs =
[exitBinding digraphs, pasteRegisterBinding, digraphBinding digraphs
, oneshotNormalBinding, completionBinding, cursorBinding]
exitBinding :: [(String, Char)] -> VimBinding
exitBinding digraphs = VimBindingE f
where
f :: EventString -> VimState -> MatchResult (EditorM RepeatToken)
f evs (VimState { vsMode = (Insert _) })
| evs `elem` ["<Esc>", "<C-c>"]
= WholeMatch $ do
count <- getCountE
(Insert starter) <- fmap vsMode getEditorDyn
when (count > 1) $ do
inputEvents <- fmap (parseEvents . vsOngoingInsertEvents) getEditorDyn
replicateM_ (count 1) $ do
when (starter `elem` "Oo") $ withCurrentBuffer $ insertB '\n'
replay digraphs inputEvents
modifyStateE $ \s -> s { vsOngoingInsertEvents = mempty }
withCurrentBuffer $ moveXorSol 1
modifyStateE $ \s -> s { vsSecondaryCursors = mempty }
resetCountE
switchModeE Normal
withCurrentBuffer $ whenM isCurrentLineAllWhiteSpaceB $ moveToSol >> deleteToEol
return Finish
f _ _ = NoMatch
rawPrintable :: VimBinding
rawPrintable = VimBindingE f
where
f :: EventString -> VimState -> MatchResult (EditorM RepeatToken)
f evs s@(VimState { vsMode = (Insert _)})
| vsPaste s && evs `notElem` ["<Esc>", "<C-c>"]
= WholeMatch . withCurrentBuffer $ do
case evs of
"<lt>" -> insertB '<'
"<CR>" -> newlineB
"<Tab>" -> insertB '\t'
"<BS>" -> bdeleteB
"<C-h>" -> bdeleteB
"<Del>" -> deleteB Character Forward
c -> insertN (R.fromText $ _unEv c)
return Continue
f _ _ = NoMatch
replay :: [(String, Char)] -> [Event] -> EditorM ()
replay _ [] = return ()
replay digraphs (e1:es1) = do
state <- getEditorDyn
let recurse = replay digraphs
evs1 = eventToEventString e1
bindingMatch1 = selectPureBinding evs1 state (defInsertMap digraphs)
case bindingMatch1 of
WholeMatch action -> void action >> recurse es1
PartialMatch -> case es1 of
[] -> return ()
(e2:es2) -> do
let evs2 = evs1 <> eventToEventString e2
bindingMatch2 = selectPureBinding evs2 state (defInsertMap digraphs)
case bindingMatch2 of
WholeMatch action -> void action >> recurse es2
_ -> recurse es2
_ -> recurse es1
oneshotNormalBinding :: VimBinding
oneshotNormalBinding = VimBindingE (f . T.unpack . _unEv)
where
f "<C-o>" (VimState { vsMode = Insert _ }) = PartialMatch
f ('<':'C':'-':'o':'>':evs) (VimState { vsMode = Insert _ }) =
action evs <$ stringToMove (Ev . T.pack $ dropWhile isDigit evs)
f _ _ = NoMatch
action evs = do
let (countString, motionCmd) = span isDigit evs
WholeMatch (Move _style _isJump move) = stringToMove . Ev . T.pack $ motionCmd
withCurrentBuffer $ move (if null countString then Nothing else Just (read countString))
return Continue
pasteRegisterBinding :: VimBinding
pasteRegisterBinding = VimBindingE (f . T.unpack . _unEv)
where f "<C-r>" (VimState { vsMode = Insert _ }) = PartialMatch
f ('<':'C':'-':'r':'>':regName:[]) (VimState { vsMode = Insert _ })
= WholeMatch $ do
mr <- getRegisterE regName
case mr of
Nothing -> return ()
Just (Register _style rope) -> withCurrentBuffer $ insertRopeWithStyleB rope Inclusive
return Continue
f _ _ = NoMatch
digraphBinding :: [(String, Char)] -> VimBinding
digraphBinding digraphs = VimBindingE (f . T.unpack . _unEv)
where f ('<':'C':'-':'k':'>':c1:c2:[]) (VimState { vsMode = Insert _ })
= WholeMatch $ do
maybe (return ()) (withCurrentBuffer . insertB) $ charFromDigraph digraphs c1 c2
return Continue
f ('<':'C':'-':'k':'>':_c1:[]) (VimState { vsMode = Insert _ }) = PartialMatch
f "<C-k>" (VimState { vsMode = Insert _ }) = PartialMatch
f _ _ = NoMatch
printable :: VimBinding
printable = VimBindingE f
where f evs state@(VimState { vsMode = Insert _ } ) =
case selectBinding evs state (specials undefined) of
NoMatch -> WholeMatch (printableAction evs)
_ -> NoMatch
f _ _ = NoMatch
printableAction :: EventString -> EditorM RepeatToken
printableAction evs = do
saveInsertEventStringE evs
currentCursor <- withCurrentBuffer pointB
secondaryCursors <- fmap vsSecondaryCursors getEditorDyn
let allCursors = currentCursor :| secondaryCursors
marks <- withCurrentBuffer $ forM' allCursors $ \cursor -> do
moveTo cursor
getMarkB Nothing
let (insertB', insertN', deleteB', bdeleteB', deleteRegionB') =
if null secondaryCursors
then (BA.insertB, BA.insertN, BA.deleteB,
BA.bdeleteB, BA.deleteRegionB)
else (B.insertB, B.insertN, B.deleteB,
B.bdeleteB, B.deleteRegionB)
let bufAction = case T.unpack . _unEv $ evs of
(c:[]) -> insertB' c
"<CR>" -> do
isOldLineEmpty <- isCurrentLineEmptyB
shouldTrimOldLine <- isCurrentLineAllWhiteSpaceB
if isOldLineEmpty
then newlineB
else if shouldTrimOldLine
then savingPointB $ do
moveToSol
newlineB
else do
newlineB
indentAsTheMostIndentedNeighborLineB
firstNonSpaceB
"<Tab>" -> do
IndentSettings et _ts sw <- indentSettingsB
if et
then insertN' . R.fromString $ replicate sw ' '
else insertB' '\t'
"<C-t>" -> shiftIndentOfRegionB 1 =<< regionOfB Line
"<C-d>" -> shiftIndentOfRegionB (1) =<< regionOfB Line
"<C-e>" -> insertCharWithBelowB
"<C-y>" -> insertCharWithAboveB
"<BS>" -> bdeleteB'
"<C-h>" -> bdeleteB'
"<Del>" -> deleteB' Character Forward
"<C-w>" -> deleteRegionB' =<< regionOfPartNonEmptyB unitViWordOnLine Backward
"<C-u>" -> bdeleteLineB
"<lt>" -> insertB' '<'
evs' -> error $ "Unhandled event " <> show evs' <> " in insert mode"
updatedCursors <- withCurrentBuffer $ do
updatedCursors <- forM' marks $ \mark -> do
moveTo =<< use (markPointA mark)
bufAction
pointB
mapM_ deleteMarkB $ toList marks
moveTo $ head updatedCursors
return $ toList updatedCursors
modifyStateE $ \s -> s { vsSecondaryCursors = drop 1 updatedCursors }
return Continue
where
forM' :: Monad m => NonEmpty a -> (a -> m b) -> m (NonEmpty b)
forM' (x :| xs) f = liftM2 (:|) (f x) (forM xs f)
completionBinding :: VimBinding
completionBinding = VimBindingE (f . T.unpack . _unEv)
where f evs (VimState { vsMode = (Insert _) })
| evs `elem` ["<C-n>", "<C-p>"]
= WholeMatch $ do
let _direction = if evs == "<C-n>" then Forward else Backward
completeWordB FromAllBuffers
return Continue
f _ _ = NoMatch
cursorBinding :: VimBinding
cursorBinding = VimBindingE f
where f evs (VimState { vsMode = (Insert _) })
| evs `elem` ["<Up>", "<Left>", "<Down>", "<Right>"]
= WholeMatch $ do
let WholeMatch (Move _style _isJump move) = stringToMove evs
withCurrentBuffer $ move Nothing
return Continue
f _ _ = NoMatch