module Yi.Keymap.Vim2.Motion
( Move(..)
, CountedMove(..)
, stringToMove
, regionOfMoveB
, changeMoveStyle
) where
import Prelude ()
import Yi.Prelude
import Control.Monad (replicateM_)
import Data.Maybe (fromMaybe)
import Data.Tuple (uncurry)
import Yi.Buffer
import Yi.Keymap.Vim2.Common
import Yi.Keymap.Vim2.StyledRegion
data Move = Move {
moveStyle :: !RegionStyle
, moveIsJump :: !Bool
, moveAction :: (Maybe Int -> BufferM ())
}
data CountedMove = CountedMove !(Maybe Int) !Move
stringToMove :: String -> MatchResult Move
stringToMove s = lookupMove s
<|> matchGotoCharMove s
<|> matchGotoMarkMove s
lookupMove :: String -> MatchResult Move
lookupMove s = findMoveWithStyle Exclusive exclusiveMotions
<|> findMoveWithStyle Inclusive inclusiveMotions
<|> findMoveWithStyle LineWise linewiseMotions
where findMoveWithStyle style choices = fmap (uncurry (Move style))
(lookupBestMatch s (fmap regroup choices))
regroup (a, b, c) = (a, (b, c))
changeMoveStyle :: (RegionStyle -> RegionStyle) -> Move -> Move
changeMoveStyle smod (Move s j m) = Move (smod s) j m
instance Functor ((,,) a b) where
fmap f (a, b, c) = (a, b, f c)
linewiseMotions :: [(String, Bool, Maybe Int -> BufferM ())]
linewiseMotions = fmap withDefaultCount
[ ("j", False, discard . lineMoveRel)
, ("k", False, discard . lineMoveRel . negate)
, ("<Down>", False, discard . lineMoveRel)
, ("<Up>", False, discard . lineMoveRel . negate)
, ("-", False, const firstNonSpaceB <=< discard . lineMoveRel . negate)
, ("+", False, const firstNonSpaceB <=< discard . lineMoveRel)
, ("_", False, \n -> do
when (n > 1) $ discard $ lineMoveRel (n 1)
firstNonSpaceB)
, ("gg", True, discard . gotoLn)
, ("<C-b>", False, scrollScreensB . negate)
, ("<PageUp>", False, scrollScreensB . negate)
, ("<C-f>", False, scrollScreensB)
, ("<PageDown>", False, scrollScreensB)
]
++ [("G", True, gotoXOrEOF)]
exclusiveMotions :: [(String, Bool, Maybe Int -> BufferM ())]
exclusiveMotions = fmap withDefaultCount
[ ("h", False, moveXorSol)
, ("l", False, moveXorEol)
, ("<Left>", False, moveXorSol)
, ("<Right>", False, moveXorEol)
, ("w", False, moveForwardB unitViWord)
, ("W", False, moveForwardB unitViWORD)
, ("b", False, moveBackwardB unitViWord)
, ("B", False, moveBackwardB unitViWORD)
, ("^", False, const firstNonSpaceB)
, ("g^", False, const firstNonSpaceB)
, ("g0", False, const moveToSol)
, ("<Home>", False, const moveToSol)
, ("|", False, \n -> moveToSol >> moveXorEol (n 1))
, ("(", True, moveBackwardB unitSentence)
, (")", True, moveForwardB unitSentence)
, ("{", True, moveBackwardB unitEmacsParagraph)
, ("}", True, moveForwardB unitEmacsParagraph)
]
inclusiveMotions :: [(String, Bool, Maybe Int -> BufferM ())]
inclusiveMotions = fmap (\(key, action) -> (key, False, action . fromMaybe 1))
[
("e", repeat $ genMoveB unitViWord (Forward, InsideBound) Forward)
, ("E", repeat $ genMoveB unitViWORD (Forward, InsideBound) Forward)
, ("ge", repeat $ genMoveB unitViWord (Forward, InsideBound) Backward)
, ("gE", repeat $ genMoveB unitViWORD (Forward, InsideBound) Backward)
, ("g$", \n -> do
when (n > 1) $ discard $ lineMoveRel (n 1)
moveToEol)
, ("<End>", const $ moveToEol >> leftOnEol)
, ("$", \n -> do
when (n > 1) $ discard $ lineMoveRel (n 1)
moveToEol
leftOnEol)
, ("g_", \n -> do
when (n > 1) $ discard $ lineMoveRel (n 1)
lastNonSpaceB)
]
++
[("%", True,
\maybeCount -> case maybeCount of
Nothing -> findMatchingPairB
Just percent -> movePercentageFileB percent)
]
repeat :: BufferM () -> Int -> BufferM ()
repeat = flip replicateM_
regionOfMoveB :: CountedMove -> BufferM StyledRegion
regionOfMoveB = normalizeRegion <=< regionOfMoveB'
regionOfMoveB' :: CountedMove -> BufferM StyledRegion
regionOfMoveB' (CountedMove n (Move style _isJump move)) = do
region <- mkRegion <$> pointB <*> destinationOfMoveB
(move n >> when (style == Inclusive) leftOnEol)
return $! StyledRegion style region
moveForwardB, moveBackwardB :: TextUnit -> Int -> BufferM ()
moveForwardB unit = repeat $ genMoveB unit (Backward,InsideBound) Forward
moveBackwardB unit = repeat $ moveB unit Backward
gotoXOrEOF :: Maybe Int -> BufferM ()
gotoXOrEOF n = case n of
Nothing -> botB >> moveToSol
Just n' -> gotoLn n' >> moveToSol
withDefaultCount :: (String, Bool, Int -> BufferM ()) -> (String, Bool, Maybe Int -> BufferM ())
withDefaultCount = fmap (. fromMaybe 1)
matchGotoMarkMove :: String -> MatchResult Move
matchGotoMarkMove (m:_) | m `notElem` "'`" = NoMatch
matchGotoMarkMove (_:[]) = PartialMatch
matchGotoMarkMove (m:c:[]) = WholeMatch $ Move style True action
where style = if m == '`' then Inclusive else LineWise
action _mcount = do
mmark <- mayGetMarkB [c]
case mmark of
Nothing -> fail $ "Mark " ++ show c ++ " not set"
Just mark -> moveTo =<< getMarkPointB mark
matchGotoMarkMove _ = NoMatch
matchGotoCharMove :: String -> MatchResult Move
matchGotoCharMove (m:[]) | m `elem` "fFtT" = PartialMatch
matchGotoCharMove (m:c:[]) | m `elem` "fFtT" = WholeMatch $ Move style False action
where (dir, style, move) =
case m of
'f' -> (Forward, Inclusive, nextCInLineInc c)
't' -> (Forward, Inclusive, nextCInLineExc c)
'F' -> (Backward, Exclusive, prevCInLineInc c)
'T' -> (Backward, Exclusive, prevCInLineExc c)
_ -> error "can't happen"
action mcount = do
let count = fromMaybe 1 mcount
p0 <- pointB
replicateM_ (count 1) $ do
move
moveB Character dir
p1 <- pointB
move
p2 <- pointB
when (p1 == p2) $ moveTo p0
matchGotoCharMove _ = NoMatch