module Yi.Keymap.Vim.VisualMap ( defVisualMap ) where
import Control.Applicative ((<$), (<$>))
import Control.Lens ((.=))
import Control.Monad (forM_, void)
import Data.Char (ord)
import Data.List (group)
import Data.Maybe (fromJust)
import qualified Data.Text as T (unpack)
import Yi.Buffer.Adjusted hiding (Insert)
import Yi.Editor
import Yi.Keymap.Vim.Common
import Yi.Keymap.Vim.Operator (VimOperator (..), opDelete, stringToOperator)
import Yi.Keymap.Vim.StateUtils
import Yi.Keymap.Vim.StyledRegion (StyledRegion (StyledRegion), transformCharactersInRegionB)
import Yi.Keymap.Vim.Tag (gotoTag)
import Yi.Keymap.Vim.Utils (matchFromBool, mkChooseRegisterBinding, mkMotionBinding)
import Yi.MiniBuffer (spawnMinibufferE)
import Yi.Monad (whenM)
import qualified Yi.Rope as R (toText)
import Yi.Tag (Tag (Tag))
import Yi.Utils (SemiNum ((-~)))
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")
, ("s", "c")
, ("S", "c")
, ("C", "c")
, ("~", "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` ['o', 'O']
= 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."
case cursors of
(mainCursor : _) -> withCurrentBuffer (moveTo mainCursor)
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