module Yi.Keymap.Vim.VisualMap ( defVisualMap ) where
import Control.Applicative
import Control.Lens hiding ((-~), op)
import Control.Monad
import Data.Char (ord)
import Data.List (group)
import Data.Maybe (fromJust)
import qualified Data.Text as T
import Yi.Buffer.Adjusted hiding (Insert)
import Yi.Editor
import Yi.Keymap.Vim.Common
import Yi.Keymap.Vim.Operator
import Yi.Keymap.Vim.StateUtils
import Yi.Keymap.Vim.StyledRegion
import Yi.Keymap.Vim.Tag
import Yi.Keymap.Vim.Utils
import Yi.MiniBuffer
import Yi.Monad
import qualified Yi.Rope as R
import Yi.Tag
import Yi.Utils
defVisualMap :: [VimOperator] -> [VimBinding]
defVisualMap operators =
[escBinding, motionBinding, changeVisualStyleBinding, setMarkBinding]
++ [chooseRegisterBinding]
++ operatorBindings operators ++ digitBindings ++ [replaceBinding, switchEdgeBinding]
++ [insertBinding, exBinding, shiftDBinding]
++ [tagJumpBinding]
escAction :: EditorM RepeatToken
escAction = do
resetCountE
clrStatus
withCurrentBuffer $ do
setVisibleSelection False
putRegionStyle Inclusive
switchModeE Normal
return Drop
escBinding :: VimBinding
escBinding = VimBindingE f
where f evs (VimState { vsMode = (Visual _) }) = escAction <$
matchFromBool (evs `elem` ["<Esc>", "<C-c>"])
f _ _ = NoMatch
exBinding :: VimBinding
exBinding = VimBindingE f
where f ":" (VimState { vsMode = (Visual _) }) = WholeMatch $ do
void $ spawnMinibufferE ":" id
withCurrentBuffer $ writeN "'<,'>"
switchModeE Ex
return Finish
f _ _ = NoMatch
digitBindings :: [VimBinding]
digitBindings = zeroBinding : fmap mkDigitBinding ['1' .. '9']
zeroBinding :: VimBinding
zeroBinding = VimBindingE f
where f "0" (VimState { vsMode = (Visual _) }) = WholeMatch $ do
currentState <- getEditorDyn
case vsCount currentState of
Just c -> do
setCountE (10 * c)
return Continue
Nothing -> do
withCurrentBuffer moveToSol
resetCountE
setStickyEolE False
return Continue
f _ _ = NoMatch
setMarkBinding :: VimBinding
setMarkBinding = VimBindingE (f . T.unpack . _unEv)
where f "m" (VimState { vsMode = (Visual _) }) = PartialMatch
f ('m':c:[]) (VimState { vsMode = (Visual _) }) = WholeMatch $ do
withCurrentBuffer $ setNamedMarkHereB [c]
return Continue
f _ _ = NoMatch
changeVisualStyleBinding :: VimBinding
changeVisualStyleBinding = VimBindingE f
where f evs (VimState { vsMode = (Visual _) })
| evs `elem` ["v", "V", "<C-v>"]
= WholeMatch $ do
currentMode <- fmap vsMode getEditorDyn
let newStyle = case evs of
"v" -> Inclusive
"V" -> LineWise
"<C-v>" -> Block
_ -> error "Just silencing false positive warning."
newMode = Visual newStyle
if newMode == currentMode
then escAction
else do
modifyStateE $ \s -> s { vsMode = newMode }
withCurrentBuffer $ do
putRegionStyle newStyle
rectangleSelectionA .= (Block == newStyle)
setVisibleSelection True
return Finish
f _ _ = NoMatch
mkDigitBinding :: Char -> VimBinding
mkDigitBinding c = VimBindingE (f . T.unpack . _unEv)
where f [c'] (VimState { vsMode = (Visual _) }) | c == c'
= WholeMatch $ do
modifyStateE mutate
return Continue
f _ _ = NoMatch
mutate vs@(VimState {vsCount = Nothing}) = vs { vsCount = Just d }
mutate vs@(VimState {vsCount = Just count}) = vs { vsCount = Just $ count * 10 + d }
d = ord c ord '0'
motionBinding :: VimBinding
motionBinding = mkMotionBinding Continue $
\m -> case m of
Visual _ -> True
_ -> False
regionOfSelectionB :: BufferM Region
regionOfSelectionB = savingPointB $ do
start <- getSelectionMarkPointB
stop <- pointB
return $! mkRegion start stop
operatorBindings :: [VimOperator] -> [VimBinding]
operatorBindings operators = fmap mkOperatorBinding $ operators ++ visualOperators
where visualOperators = fmap synonymOp
[ ("x", "d")
, ("~", "g~")
, ("Y", "y")
, ("u", "gu")
, ("U", "gU")
]
synonymOp (newName, existingName) =
VimOperator newName . operatorApplyToRegionE . fromJust
. stringToOperator operators $ existingName
chooseRegisterBinding :: VimBinding
chooseRegisterBinding = mkChooseRegisterBinding $
\s -> case s of
(VimState { vsMode = (Visual _) }) -> True
_ -> False
shiftDBinding :: VimBinding
shiftDBinding = VimBindingE (f . T.unpack . _unEv)
where f "D" (VimState { vsMode = (Visual _) }) = WholeMatch $ do
(Visual style) <- vsMode <$> getEditorDyn
reg <- withCurrentBuffer regionOfSelectionB
case style of
Block -> withCurrentBuffer $ do
(start, lengths) <- shapeOfBlockRegionB reg
moveTo start
startCol <- curCol
forM_ (reverse [0 .. length lengths 1]) $ \l -> do
moveTo start
void $ lineMoveRel l
whenM (fmap (== startCol) curCol) deleteToEol
leftOnEol
_ -> do
reg' <- withCurrentBuffer $ convertRegionToStyleB reg LineWise
reg'' <- withCurrentBuffer $ mkRegionOfStyleB (regionStart reg')
(regionEnd reg' -~ Size 1)
Exclusive
void $ operatorApplyToRegionE opDelete 1 $ StyledRegion LineWise reg''
resetCountE
switchModeE Normal
return Finish
f _ _ = NoMatch
mkOperatorBinding :: VimOperator -> VimBinding
mkOperatorBinding op = VimBindingE f
where
f evs (VimState { vsMode = (Visual _) }) =
action <$ evs `matchesString` Ev (_unOp $ operatorName op)
f _ _ = NoMatch
action = do
(Visual style) <- vsMode <$> getEditorDyn
region <- withCurrentBuffer regionOfSelectionB
count <- getCountE
token <- operatorApplyToRegionE op count $ StyledRegion style region
resetCountE
clrStatus
withCurrentBuffer $ do
setVisibleSelection False
putRegionStyle Inclusive
return token
replaceBinding :: VimBinding
replaceBinding = VimBindingE (f . T.unpack . _unEv)
where f evs (VimState { vsMode = (Visual _) }) =
case evs of
"r" -> PartialMatch
('r':c:[]) -> WholeMatch $ do
(Visual style) <- vsMode <$> getEditorDyn
region <- withCurrentBuffer regionOfSelectionB
withCurrentBuffer $ transformCharactersInRegionB (StyledRegion style region)
(\x -> if x == '\n' then x else c)
switchModeE Normal
return Finish
_ -> NoMatch
f _ _ = NoMatch
switchEdgeBinding :: VimBinding
switchEdgeBinding = VimBindingE (f . T.unpack . _unEv)
where f [c] (VimState { vsMode = (Visual _) }) | c `elem` "oO"
= WholeMatch $ do
(Visual style) <- vsMode <$> getEditorDyn
withCurrentBuffer $ do
here <- pointB
there <- getSelectionMarkPointB
(here', there') <- case (c, style) of
('O', Block) -> flipRectangleB here there
(_, _) -> return (there, here)
moveTo here'
setSelectionMarkPointB there'
return Continue
f _ _ = NoMatch
insertBinding :: VimBinding
insertBinding = VimBindingE (f . T.unpack . _unEv)
where f evs (VimState { vsMode = (Visual _) }) | evs `elem` group "IA"
= WholeMatch $ do
(Visual style) <- vsMode <$> getEditorDyn
region <- withCurrentBuffer regionOfSelectionB
cursors <- withCurrentBuffer $ case evs of
"I" -> leftEdgesOfRegionB style region
"A" -> rightEdgesOfRegionB style region
_ -> error "Just silencing ghc's false positive warning."
withCurrentBuffer $ moveTo $ head cursors
modifyStateE $ \s -> s { vsSecondaryCursors = drop 1 cursors }
switchModeE $ Insert (head evs)
return Continue
f _ _ = NoMatch
tagJumpBinding :: VimBinding
tagJumpBinding = VimBindingY (f . T.unpack . _unEv)
where f "<C-]>" (VimState { vsMode = (Visual _) })
= WholeMatch $ do
tag <- Tag . R.toText <$> withCurrentBuffer
(regionOfSelectionB >>= readRegionB)
withEditor $ switchModeE Normal
gotoTag tag 0 Nothing
return Finish
f _ _ = NoMatch