module Yi.Keymap.Vim.NormalOperatorPendingMap
(defNormalOperatorPendingMap) where
import Control.Applicative
import Control.Monad
import Data.Char (isDigit)
import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe, fromJust)
import Data.Monoid
import qualified Data.Text as T
import Yi.Buffer.Adjusted hiding (Insert)
import Yi.Editor
import Yi.Keymap.Keys
import Yi.Keymap.Vim.Common
import Yi.Keymap.Vim.Motion
import Yi.Keymap.Vim.Operator
import Yi.Keymap.Vim.StateUtils
import Yi.Keymap.Vim.StyledRegion
import Yi.Keymap.Vim.TextObject
import Yi.Keymap.Vim.Utils
defNormalOperatorPendingMap :: [VimOperator] -> [VimBinding]
defNormalOperatorPendingMap operators = [textObject operators, escBinding]
textObject :: [VimOperator] -> VimBinding
textObject operators = VimBindingE f
where
f evs vs = case vsMode vs of
NormalOperatorPending _ -> WholeMatch $ action evs
_ -> NoMatch
action (Ev evs) = do
currentState <- getEditorDyn
let partial = vsTextObjectAccumulator currentState
opChar = Ev . T.pack $ lastCharForOperator op
op = fromJust $ stringToOperator operators opname
(NormalOperatorPending opname) = vsMode currentState
let evs' = if opname == Op "c" && T.last evs == 'w' &&
(case parseOperand opChar (evr evs) of
JustMove _ -> True
_ -> False)
then T.init evs `T.snoc` 'e'
else evs
evr x = T.unpack . _unEv $ partial <> Ev x
operand = parseOperand opChar (evr evs')
case operand of
NoOperand -> do
dropTextObjectAccumulatorE
resetCountE
switchModeE Normal
return Drop
PartialOperand -> do
accumulateTextObjectEventE (Ev evs)
return Continue
_ -> do
count <- getCountE
dropTextObjectAccumulatorE
token <- case operand of
JustTextObject cto@(CountedTextObject n _) -> do
normalizeCountE (Just n)
operatorApplyToTextObjectE op 1 $
changeTextObjectCount (count * n) cto
JustMove (CountedMove n m) -> do
mcount <- getMaybeCountE
normalizeCountE n
region <- withCurrentBuffer $ regionOfMoveB $ CountedMove (maybeMult mcount n) m
operatorApplyToRegionE op 1 region
JustOperator n style -> do
normalizeCountE (Just n)
normalizedCount <- getCountE
region <- withCurrentBuffer $ regionForOperatorLineB normalizedCount style
curPoint <- withCurrentBuffer pointB
token <- operatorApplyToRegionE op 1 region
when (opname == Op "y") $
withCurrentBuffer $ moveTo curPoint
return token
_ -> error "can't happen"
resetCountE
return token
regionForOperatorLineB :: Int -> RegionStyle -> BufferM StyledRegion
regionForOperatorLineB n style = normalizeRegion =<< StyledRegion style <$> savingPointB (do
current <- pointB
if n == 1
then do
firstNonSpaceB
p0 <- pointB
return $! mkRegion p0 current
else do
void $ lineMoveRel (n2)
moveToEol
rightB
firstNonSpaceB
p1 <- pointB
return $! mkRegion current p1)
escBinding :: VimBinding
escBinding = mkBindingE ReplaceSingleChar Drop (spec KEsc, return (), resetCount . switchMode Normal)
data OperandParseResult
= JustTextObject !CountedTextObject
| JustMove !CountedMove
| JustOperator !Int !RegionStyle
| PartialOperand
| NoOperand
parseOperand :: EventString -> String -> OperandParseResult
parseOperand opChar s = parseCommand mcount styleMod opChar commandString
where (mcount, styleModString, commandString) = splitCountModifierCommand s
styleMod = case styleModString of
"" -> id
"V" -> const LineWise
"<C-v>" -> const Block
"v" -> \style -> case style of
Exclusive -> Inclusive
_ -> Exclusive
_ -> error "Can't happen"
parseCommand :: Maybe Int -> (RegionStyle -> RegionStyle)
-> EventString -> String -> OperandParseResult
parseCommand _ _ _ "" = PartialOperand
parseCommand _ _ _ "i" = PartialOperand
parseCommand _ _ _ "a" = PartialOperand
parseCommand _ _ _ "g" = PartialOperand
parseCommand n sm o s | o' == s = JustOperator (fromMaybe 1 n) (sm LineWise)
where o' = T.unpack . _unEv $ o
parseCommand n sm _ "0" =
let m = Move Exclusive False (const moveToSol)
in JustMove (CountedMove n (changeMoveStyle sm m))
parseCommand n sm _ s = case stringToMove . Ev $ T.pack s of
WholeMatch m -> JustMove $ CountedMove n $ changeMoveStyle sm m
PartialMatch -> PartialOperand
NoMatch -> case stringToTextObject s of
Just to -> JustTextObject $ CountedTextObject (fromMaybe 1 n)
$ changeTextObjectStyle sm to
Nothing -> NoOperand
splitCountModifierCommand :: String -> (Maybe Int, String, String)
splitCountModifierCommand = go "" Nothing [""]
where go "" Nothing mods "0" = (Nothing, head mods, "0")
go ds count mods (h:t) | isDigit h = go (ds <> [h]) count mods t
go ds@(_:_) count mods s@(h:_) | not (isDigit h) = go [] (maybeMult count (Just (read ds))) mods s
go [] count mods (h:t) | h `elem` "vV" = go [] count ([h]:mods) t
go [] count mods s | "<C-v>" `isPrefixOf` s = go [] count ("<C-v>":mods) (drop 5 s)
go [] count mods s = (count, head mods, s)
go ds count mods [] = (maybeMult count (Just (read ds)), head mods, [])
go (_:_) _ _ (_:_) = error "Can't happen because isDigit and not isDigit cover every case"