-
Notifications
You must be signed in to change notification settings - Fork 199
/
NormalOperatorPendingMap.hs
172 lines (157 loc) · 6.87 KB
/
NormalOperatorPendingMap.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}
-- |
-- Module : Yi.Keymap.Vim.NormalOperatorPendingMap
-- License : GPL-2
-- Maintainer : yi-devel@googlegroups.com
-- Stability : experimental
-- Portability : portable
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
-- vim treats cw as ce
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
-- TODO: fix parseOperand to take EventString as second arg
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 (n-2)
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 -- ^ like dd and d2vd
| 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"
-- | TODO: should this String be EventString?
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
-- TODO: setup doctests
-- Parse event string that can go after operator
-- w -> (Nothing, "", "w")
-- 2w -> (Just 2, "", "w")
-- V2w -> (Just 2, "V", "w")
-- v2V3<C-v>w -> (Just 6, "<C-v>", "w")
-- vvvvvvvvvvvvvw -> (Nothing, "v", "w")
-- 0 -> (Nothing, "", "0")
-- V0 -> (Nothing, "V", "0")
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"