module Yi.Keymap.Vim2.VisualMap
( defVisualMap
) where
import Control.Applicative
import Control.Monad
import Control.Lens hiding ((-~), op)
import Data.Char (ord)
import Data.List (group)
import Data.Maybe (fromJust)
import Yi.Buffer hiding (Insert)
import Yi.Editor
import Yi.Keymap.Vim2.Common
import Yi.Keymap.Vim2.Operator
import Yi.Keymap.Vim2.StateUtils
import Yi.Keymap.Vim2.StyledRegion
import Yi.Keymap.Vim2.Utils
import Yi.MiniBuffer
import Yi.Utils
import Yi.Monad
defVisualMap :: [VimOperator] -> [VimBinding]
defVisualMap operators =
[escBinding, motionBinding, changeVisualStyleBinding, setMarkBinding]
++ [chooseRegisterBinding]
++ operatorBindings operators ++ digitBindings ++ [replaceBinding, switchEdgeBinding]
++ [insertBinding, exBinding, shiftDBinding]
escAction :: EditorM RepeatToken
escAction = do
resetCountE
clrStatus
withBuffer0 $ do
setVisibleSelection False
assign regionStyleA 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
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 <- getDynamic
case vsCount currentState of
Just c -> do
setDynamic $ currentState { vsCount = Just (10 * c) }
return Continue
Nothing -> do
withBuffer0 moveToSol
setDynamic $ resetCount currentState
return Continue
f _ _ = NoMatch
setMarkBinding :: VimBinding
setMarkBinding = VimBindingE f
where f "m" (VimState { vsMode = (Visual _) }) = PartialMatch
f ('m':c:[]) (VimState { vsMode = (Visual _) }) = WholeMatch $ do
withBuffer0 $ 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 getDynamic
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 }
withBuffer0 $ do
assign regionStyleA newStyle
assign rectangleSelectionA $ Block == newStyle
setVisibleSelection True
return Finish
f _ _ = NoMatch
mkDigitBinding :: Char -> VimBinding
mkDigitBinding c = VimBindingE f
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
where f "D" (VimState { vsMode = (Visual _) }) = WholeMatch $ do
(Visual style) <- vsMode <$> getDynamic
reg <- withBuffer0 regionOfSelectionB
case style of
Block -> withBuffer0 $ 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' <- withBuffer0 $ convertRegionToStyleB reg LineWise
reg'' <- withBuffer0 $ 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` operatorName op
f _ _ = NoMatch
action = do
(Visual style) <- vsMode <$> getDynamic
region <- withBuffer0 regionOfSelectionB
count <- getCountE
token <- operatorApplyToRegionE op count $ StyledRegion style region
resetCountE
clrStatus
withBuffer0 $ do
setVisibleSelection False
assign regionStyleA Inclusive
return token
replaceBinding :: VimBinding
replaceBinding = VimBindingE f
where f evs (VimState { vsMode = (Visual _) }) =
case evs of
"r" -> PartialMatch
('r':c:[]) -> WholeMatch $ do
(Visual style) <- vsMode <$> getDynamic
region <- withBuffer0 regionOfSelectionB
withBuffer0 $ transformCharactersInRegionB (StyledRegion style region)
(\x -> if x == '\n' then x else c)
switchModeE Normal
return Finish
_ -> NoMatch
f _ _ = NoMatch
switchEdgeBinding :: VimBinding
switchEdgeBinding = VimBindingE f
where f [c] (VimState { vsMode = (Visual _) }) | c `elem` "oO"
= WholeMatch $ do
(Visual style) <- vsMode <$> getDynamic
withBuffer0 $ 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
where f evs (VimState { vsMode = (Visual _) }) | evs `elem` group "IA"
= WholeMatch $ do
(Visual style) <- vsMode <$> getDynamic
region <- withBuffer0 regionOfSelectionB
cursors <- withBuffer0 $ case evs of
"I" -> leftEdgesOfRegionB style region
"A" -> rightEdgesOfRegionB style region
_ -> error "Just silencing ghc's false positive warning."
withBuffer0 $ moveTo $ head cursors
modifyStateE $ \s -> s { vsSecondaryCursors = drop 1 cursors }
switchModeE $ Insert (head evs)
return Continue
f _ _ = NoMatch