Skip to content

Commit 9e11b14

Browse files
Aster89Aster89
committed
Refactor f/t/F/T and enable ; and ,
 Addressing issue #60. Reimplemented <kbd>f</kbd>/<kbd>F</kbd>/<kbd>t</kbd>/<kbd>T</kbd>, and added <kbd>;</kbd>/<kbd>,</kbd> beside them. f/t/F/T store the searched-for characeter even when they are used for d/c/y commands, so ; and , behave accordingly in that case too. I'm using `baseGrapheme` out of its defining module, which the original author discouraged. This should be carefully reviewed. Not what's left is some thorough review and hopefully some cleanup.
1 parent 2976f43 commit 9e11b14

File tree

2 files changed

+79
-28
lines changed

2 files changed

+79
-28
lines changed

‎System/Console/Haskeline/LineState.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@ module System.Console.Haskeline.LineState(
55
-- * Graphemes
66
Grapheme(),
77
baseChar,
8+
baseGrapheme, -- XXX The author says no!
89
stringToGraphemes,
910
graphemesToString,
1011
modifyBaseChar,
@@ -74,7 +75,7 @@ import Data.Char
7475
-- can represent one grapheme; for example, an @a@ followed by the diacritic @\'\\768\'@ should
7576
-- be treated as one unit.
7677
data Grapheme = Grapheme {gBaseChar :: Char,
77-
combiningChars :: [Char]}
78+
combiningChars :: [Char]}
7879
deriving Eq
7980

8081
instance Show Grapheme where

‎System/Console/Haskeline/Vi.hs‎

Lines changed: 77 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE LambdaCase #-}
12
#if __GLASGOW_HASKELL__ < 802
23
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
34
#endif
@@ -21,15 +22,20 @@ type EitherMode = Either CommandMode InsertMode
2122

2223
type SavedCommand m = Command (ViT m) (ArgMode CommandMode) EitherMode
2324

25+
data InlineSearch = F -- f | F
26+
| T -- t | T
27+
2428
data ViState m = ViState {
2529
lastCommand :: SavedCommand m,
26-
lastSearch :: [Grapheme]
30+
lastSearch :: [Grapheme],
31+
lastInlineSearch :: Maybe (Char, InlineSearch, Direction)
2732
}
2833

2934
emptyViState :: Monad m => ViState m
3035
emptyViState = ViState {
3136
lastCommand = return . Left . argState,
32-
lastSearch = []
37+
lastSearch = [],
38+
lastInlineSearch = Nothing
3339
}
3440

3541
type ViT m = StateT (ViState m) (InputCmdT m)
@@ -134,6 +140,40 @@ simpleCmdActions = choiceCmd [
134140
, simpleKey KillLine `useKey` (noArg >=> killAndStoreC (SimpleMove moveToStart))
135141
]
136142

143+
inlineSearchActions :: InputKeyCmd (ArgMode CommandMode) CommandMode
144+
inlineSearchActions = choiceCmd
145+
[ simpleChar 'f' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch F Forward c >>=) . viInlineSearch id)
146+
, simpleChar 'F' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch F Reverse c >>=) . viInlineSearch id)
147+
, simpleChar 't' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch T Forward c >>=) . viInlineSearch id)
148+
, simpleChar 'T' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch T Reverse c >>=) . viInlineSearch id)
149+
, simpleChar ';' `useKey` ((getLastInlineSearch >>=) . viInlineSearch id)
150+
, simpleChar ',' `useKey` ((getLastInlineSearch >>=) . viInlineSearch flipDir)
151+
]
152+
153+
viInlineSearch :: forall m. Monad m => (Direction -> Direction)
154+
-> ArgMode CommandMode
155+
-> (Maybe (Char, InlineSearch, Direction))
156+
-> CmdM (ViT m) CommandMode
157+
viInlineSearch flipdir = \s -> \case
158+
Nothing -> return $ argState s
159+
Just (g, fOrT, dir) -> setState $ (applyArg . withCommandMode . search fOrT (flipdir dir)) (== g) s
160+
where
161+
search :: InlineSearch -> Direction -> (Char -> Bool) -> InsertMode -> InsertMode
162+
search F Forward = goRightUntil . overChar
163+
search F Reverse = goLeftUntil . overChar
164+
search T Forward = goRightUntil . beforeChar
165+
search T Reverse = goLeftUntil . afterChar
166+
167+
getLastInlineSearch :: forall m. Monad m => CmdM (ViT m) (Maybe (Char, InlineSearch, Direction))
168+
getLastInlineSearch = lastInlineSearch <$> (get :: CmdM (ViT m) (ViState m)) -- TODO: ideally this is a usage of `gets`
169+
170+
saveInlineSearch :: forall m. Monad m => InlineSearch -> Direction -> Char
171+
-> CmdM (ViT m) (Maybe (Char, InlineSearch, Direction))
172+
saveInlineSearch fOrT dir char
173+
= do let ret = Just (char, fOrT, dir)
174+
modify $ \(vs :: ViState m) -> vs {lastInlineSearch = ret}
175+
return ret
176+
137177
replaceOnce :: InputCmd CommandMode CommandMode
138178
replaceOnce = try $ changeFromChar replaceChar
139179

@@ -150,37 +190,38 @@ repeatedCommands = choiceCmd [argumented, doBefore noArg repeatableCommands]
150190
]
151191

152192
pureMovements :: InputKeyCmd (ArgMode CommandMode) CommandMode
153-
pureMovements = choiceCmd $ charMovements ++ map mkSimpleCommand movements
193+
pureMovements = choiceCmd $ map mkSimpleCommand movements
154194
where
155-
charMovements = [ charMovement 'f' $ \c -> goRightUntil $ overChar (==c)
156-
, charMovement 'F' $ \c -> goLeftUntil $ overChar (==c)
157-
, charMovement 't' $ \c -> goRightUntil $ beforeChar (==c)
158-
, charMovement 'T' $ \c -> goLeftUntil $ afterChar (==c)
159-
]
160-
mkSimpleCommand (k,move) = k +> change (applyCmdArg move)
161-
charMovement c move = simpleChar c +> keyChoiceCmd [
162-
useChar (change . applyCmdArg . move)
163-
, withoutConsuming (change argState)
164-
]
165-
166-
useMovementsForKill :: Command m s t -> (KillHelper -> Command m s t) -> KeyCommand m s t
167-
useMovementsForKill alternate useHelper = choiceCmd $
195+
mkSimpleCommand (k, move) = k `useKey` change (applyCmdArg move)
196+
197+
useMovementsForKill :: (KillHelper -> Command m s t) -> KeyCommand m s t
198+
useMovementsForKill useHelper = choiceCmd $
168199
specialCases
169200
++ map (\(k,move) -> k `useKey` useHelper (SimpleMove move)) movements
170201
where
171202
specialCases = [ simpleChar 'e' `useKey` useHelper (SimpleMove goToWordDelEnd)
172203
, simpleChar 'E' `useKey` useHelper (SimpleMove goToBigWordDelEnd)
173204
, simpleChar '%' `useKey` useHelper (GenericKill deleteMatchingBrace)
174-
-- Note 't' and 'f' behave differently than in pureMovements.
175-
, charMovement 'f' $ \c -> goRightUntil $ afterChar (==c)
176-
, charMovement 'F' $ \c -> goLeftUntil $ overChar (==c)
177-
, charMovement 't' $ \c -> goRightUntil $ overChar (==c)
178-
, charMovement 'T' $ \c -> goLeftUntil $ afterChar (==c)
179205
]
180-
charMovement c move = simpleChar c +> keyChoiceCmd [
181-
useChar (useHelper . SimpleMove . move)
182-
, withoutConsuming alternate]
183206

207+
useInlineSearchForKill :: Monad m => Command (ViT m) s t -> (KillHelper -> Command (ViT m) s t) -> KeyMap (Command (ViT m) s t)
208+
useInlineSearchForKill alternate killCmd = choiceCmd
209+
[ simpleChar 'f' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch F Forward c >>=) . getSearchAndKill)
210+
, simpleChar 'F' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch F Reverse c >>=) . getSearchAndKill)
211+
, simpleChar 't' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch T Forward c >>=) . getSearchAndKill)
212+
, simpleChar 'T' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch T Reverse c >>=) . getSearchAndKill)
213+
, simpleChar ';' `useKey` ((getLastInlineSearch >>=) . getSearchAndKill)
214+
, simpleChar ',' `useKey` ((reverseDir <$> getLastInlineSearch >>=) . getSearchAndKill)
215+
]
216+
where
217+
getSearchAndKill = \s
218+
-> \case (Just (g, fOrT, forOrRev)) -> killCmd (SimpleMove $ moveForKill fOrT forOrRev $ (== g)) s
219+
Nothing -> alternate s
220+
221+
moveForKill F Forward = goRightUntil . afterChar
222+
moveForKill F Reverse = goLeftUntil . overChar
223+
moveForKill T Forward = goRightUntil . overChar
224+
moveForKill T Reverse = goLeftUntil . afterChar
184225

185226
repeatableCommands :: InputKeyCmd (ArgMode CommandMode) EitherMode
186227
repeatableCommands = choiceCmd
@@ -201,6 +242,7 @@ repeatableCmdMode = choiceCmd
201242
, simpleChar 'd' `useKey` deletionCmd
202243
, simpleChar 'y' `useKey` yankCommand
203244
, ctrlChar 'w' `useKey` killAndStoreC wordErase
245+
, inlineSearchActions
204246
, pureMovements
205247
]
206248
where
@@ -220,7 +262,8 @@ deletionCmd :: InputCmd (ArgMode CommandMode) CommandMode
220262
deletionCmd = keyChoiceCmd
221263
[ reinputArg >+> deletionCmd
222264
, simpleChar 'd' `useKey` killAndStoreC killAll
223-
, useMovementsForKill (change argState) killAndStoreC
265+
, useMovementsForKill killAndStoreC
266+
, useInlineSearchForKill (change argState) killAndStoreC
224267
, withoutConsuming (change argState)
225268
]
226269

@@ -232,7 +275,8 @@ deletionToInsertCmd = keyChoiceCmd
232275
-- readline does this too, so we should also.
233276
, simpleChar 'w' `useKey` killAndStoreE (SimpleMove goToWordDelEnd)
234277
, simpleChar 'W' `useKey` killAndStoreE (SimpleMove goToBigWordDelEnd)
235-
, useMovementsForKill (fmap Left . change argState) killAndStoreE
278+
, useMovementsForKill killAndStoreE
279+
, useInlineSearchForKill (fmap Left . change argState) killAndStoreE
236280
, withoutConsuming (return . Left . argState)
237281
]
238282

@@ -241,7 +285,8 @@ yankCommand :: InputCmd (ArgMode CommandMode) CommandMode
241285
yankCommand = keyChoiceCmd
242286
[ reinputArg >+> yankCommand
243287
, simpleChar 'y' `useKey` copyAndStore killAll
244-
, useMovementsForKill (change argState) copyAndStore
288+
, useMovementsForKill copyAndStore
289+
, useInlineSearchForKill (change argState) copyAndStore
245290
, withoutConsuming (change argState)
246291
]
247292

@@ -451,3 +496,8 @@ viSearchHist dir toSearch cm = do
451496
Right sm -> do
452497
put vstate {lastSearch = toSearch'}
453498
setState (restore (foundHistory sm))
499+
500+
reverseDir :: Maybe (a, b, Direction) -> Maybe (a, b, Direction)
501+
reverseDir = (third3 flipDir <$>)
502+
where
503+
third3 f (a, b, c) = (a, b, f c)

0 commit comments

Comments
 (0)