module Yi.Keymap.Vim.VisualMap ( defVisualMap ) where
import Lens.Micro.Platform ((.=))
import Control.Monad (forM_, void)
import Data.Char (ord)
import Data.List (group)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.Text as T (unpack)
import Yi.Buffer 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.TextObject
import Yi.Keymap.Vim.Utils (matchFromBool, mkChooseRegisterBinding, mkMotionBinding, addNewLineIfNecessary)
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, textObjectBinding, changeVisualStyleBinding, setMarkBinding]
++ [chooseRegisterBinding, pasteBinding]
++ 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
withCurrentBuffer $ stickyEolA .= 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
textObjectBinding :: VimBinding
textObjectBinding = VimBindingE (f . T.unpack . _unEv)
where
f (stringToTextObject -> PartialMatch) (VimState {vsMode = Visual _}) = PartialMatch
f (stringToTextObject -> WholeMatch to) (VimState {vsMode = Visual _, vsCount = mbCount}) =
let count = fromMaybe 1 mbCount
in
WholeMatch $ do
withCurrentBuffer $ do
StyledRegion _ reg <- regionOfTextObjectB (CountedTextObject count to)
setSelectionMarkPointB (regionStart reg)
moveTo (regionEnd reg -~ 1)
return Continue
f _ _ = NoMatch
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)
escAction
return Finish
_ -> NoMatch
f _ _ = NoMatch
pasteBinding :: VimBinding
pasteBinding = VimBindingE (f . T.unpack . _unEv)
where
f "p" (VimState { vsMode = (Visual style) }) = WholeMatch $ do
register <- getRegisterE . vsActiveRegister =<< getEditorDyn
case (register, style) of
(Just (Register _style rope), LineWise) -> withCurrentBuffer $ do
region <- regionOfSelectionB
_ <- deleteRegionWithStyleB region LineWise
insertRopeWithStyleB (addNewLineIfNecessary rope) LineWise
(Just (Register Block rope), Block) -> withCurrentBuffer $ do
here <- pointB
there <- getSelectionMarkPointB
(here', there') <- flipRectangleB here there
reg <- regionOfSelectionB
void $ deleteRegionWithStyleB reg Block
moveTo (minimum [here, there, here', there'])
insertRopeWithStyleB rope Block
(Just (Register _ _), Block) ->
printMsg "Pasting non-block string into a block selection is not implemented"
(Just (Register _style rope), _) -> withCurrentBuffer $ do
region <- regionOfSelectionB
region' <- convertRegionToStyleB region Inclusive
replaceRegionB region' rope
_ -> pure ()
escAction
return Finish
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
[] -> error "No cursor to move to (in Yi.Keymap.Vim.VisualMap.insertBinding)"
(mainCursor : _) -> withCurrentBuffer (moveTo mainCursor)
modifyStateE $ \s -> s { vsSecondaryCursors = drop 1 cursors }
withCurrentBuffer $ setVisibleSelection False
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 escAction
gotoTag tag 0 Nothing
return Finish
f _ _ = NoMatch