module Yi.Keymap.Vim.Motion
( Move(..)
, CountedMove(..)
, stringToMove
, regionOfMoveB
, changeMoveStyle
) where
import Prelude hiding (repeat)
import Control.Applicative (Alternative ((<|>)), Applicative ((<*>)), (<$>))
import Control.Lens (Field3 (_3), over, use)
import Control.Monad (replicateM_, void, when, (<=<))
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import qualified Data.Text as T (unpack)
import Yi.Buffer.Adjusted
import Yi.Keymap.Vim.Common (EventString (_unEv), MatchResult (..), lookupBestMatch)
import Yi.Keymap.Vim.StyledRegion (StyledRegion (..), normalizeRegion)
data Move = Move {
moveStyle :: !RegionStyle
, moveIsJump :: !Bool
, moveAction :: Maybe Int -> BufferM ()
}
data CountedMove = CountedMove !(Maybe Int) !Move
stringToMove :: EventString -> MatchResult Move
stringToMove s = lookupMove s
<|> matchGotoCharMove (T.unpack . _unEv $ s)
<|> matchGotoMarkMove (T.unpack . _unEv $ s)
lookupMove :: EventString -> 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
linewiseMotions :: [(EventString, Bool, Maybe Int -> BufferM ())]
linewiseMotions = fmap withDefaultCount
[ ("j", False, void . lineMoveRel)
, ("gj", False, void . lineMoveVisRel)
, ("gk", False, void . lineMoveVisRel . negate)
, ("k", False, void . lineMoveRel . negate)
, ("<Down>", False, void . lineMoveRel)
, ("<Up>", False, void . lineMoveRel . negate)
, ("-", False, const firstNonSpaceB <=< void . lineMoveRel . negate)
, ("+", False, const firstNonSpaceB <=< void . lineMoveRel)
, ("_", False, \n -> do
when (n > 1) $ void $ lineMoveRel (n 1)
firstNonSpaceB)
, ("gg", True, void . gotoLn)
, ("<C-b>", False, scrollScreensB . negate)
, ("<PageUp>", False, scrollScreensB . negate)
, ("<C-f>", False, scrollScreensB)
, ("<PageDown>", False, scrollScreensB)
, ("H", True, downFromTosB . pred)
, ("M", True, const middleB)
, ("L", True, upFromBosB . pred)
]
<> [ ("G", True, gotoXOrEOF) ]
exclusiveMotions :: [(EventString, 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 :: [(EventString, 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) $ void $ lineMoveRel (n 1)
moveToEol)
, ("<End>", const $ moveToEol >> leftOnEol)
, ("$", \n -> do
when (n > 1) $ void $ lineMoveRel (n 1)
moveToEol
leftOnEol)
, ("g_", \n -> do
when (n > 1) $ void $ 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 :: (EventString, Bool, Int -> BufferM ()) -> (EventString, Bool, Maybe Int -> BufferM ())
withDefaultCount = over _3 (. 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 =<< use (markPointA mark)
matchGotoMarkMove _ = NoMatch
matchGotoCharMove :: String -> MatchResult Move
matchGotoCharMove (m:[]) | m `elem` ('f' : "FtT") = PartialMatch
matchGotoCharMove (m:"<lt>") | m `elem` ('f' : "FtT") = matchGotoCharMove (m:"<")
matchGotoCharMove (m:c:[]) | m `elem` ('f' : "FtT") = 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