diff options
| -rw-r--r-- | src/Buffer/Motion.hs | 38 | ||||
| -rw-r--r-- | src/Main.hs | 90 |
2 files changed, 79 insertions, 49 deletions
diff --git a/src/Buffer/Motion.hs b/src/Buffer/Motion.hs index fa9e059..1333b78 100644 --- a/src/Buffer/Motion.hs +++ b/src/Buffer/Motion.hs @@ -9,20 +9,20 @@ import Buffer.Class -- TODO factor Count -- TODO various Vim gX data LeftRightMotion - = GotoLeft Int - | GotoRight Int + = GotoLeft + | GotoRight | GotoFirstChar -- | GotoFirstNonBlankChar | GotoEndOfLine -- XXX in Vi this can go downwards - | GotoColumn Int - -- | GotoFindLeft Int (Char -> Bool) -- TODO don't use functions here - -- | GotoFindRight Int (Char -> Bool) -- TODO ^ dto. - -- | GotillFindLeft Int Char - -- | GotillFindRight Int Char - -- | RepeatLastFind Int - -- | RepeatLastFindReverse Int - | WordsForward Int - | WordsBackward Int + | GotoColumn + -- | GotoFindLeft (Char -> Bool) -- TODO don't use functions here + -- | GotoFindRight (Char -> Bool) -- TODO ^ dto. + -- | GotillFindLeft Char + -- | GotillFindRight Char + -- | RepeatLastFind + -- | RepeatLastFindReverse + | WordsForward + | WordsBackward deriving (Show) @@ -73,11 +73,11 @@ wordsBackward i (ls, rs) = else b' -move :: LeftRightMotion -> Buffer -> Buffer -move (GotoLeft i) = gotoLeft i -move (GotoRight i) = gotoRight i -move GotoFirstChar = gotoFirstChar -move GotoEndOfLine = gotoEndOfLine -move (GotoColumn i) = gotoColumn i -move (WordsForward i) = wordsForward i -move (WordsBackward i) = wordsBackward i +move :: LeftRightMotion -> Int -> Buffer -> Buffer +move GotoLeft c = gotoLeft c +move GotoRight c = gotoRight c +move GotoFirstChar _ = gotoFirstChar -- TODO use count +move GotoEndOfLine _ = gotoEndOfLine -- TODO use count +move GotoColumn c = gotoColumn c +move WordsForward c = wordsForward c +move WordsBackward c = wordsBackward c diff --git a/src/Main.hs b/src/Main.hs index 240dd2a..061b982 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -34,7 +34,7 @@ data VTState = VTState { buffer :: Buffer , mode :: Mode , processCount :: Int - , count :: Int + , count :: Maybe Int , register :: Char , registers :: Map Char String } @@ -54,7 +54,7 @@ main = do { mode = InsertMode , buffer = ("!while date; do sleep 1; done", "") , processCount = 0 - , count = 0 + , count = Nothing , register = defaultRegister , registers = Map.empty } @@ -150,9 +150,8 @@ data Command | Combine Command Command | Nop | RingBell - | AddCount Int - | MulCount Int - | SetCount Int + | AppendCount Int + | SetCount (Maybe Int) | SetRegister Char | DeleteEntireLine @@ -231,7 +230,8 @@ insertString s (ls, rs) = (ls ++ s, rs) execCommand :: Command -> VT () execCommand (MotionCommand x) = do - modifyBuffer (move x) + c <- gets count + modifyBuffer (move x $ maybe 1 id c) -- TODO apply mode constraints somewhere else q <- get when (mode q == NormalMode) $ @@ -319,9 +319,14 @@ execCommand Nop = return () execCommand RingBell = liftIO ringBell -execCommand (AddCount i) = modify $ \q -> q { count = i + count q } -execCommand (MulCount i) = modify $ \q -> q { count = i * count q } -execCommand (SetCount i) = modify $ \q -> q { count = i } +execCommand (AppendCount i) = + modify $ \q -> q { count = f (count q) } + where + f Nothing = Just i + f (Just c) = Just (c * 10 + i) + +execCommand (SetCount i) = + modify $ \q -> q { count = i } execCommand (SetRegister c) = modify $ \q -> q { register = c } @@ -449,41 +454,60 @@ selectRegisterMap = nmap :: Keymap nmap = - [ ("\x1b", RingBell) -- TODO cancel any unfinished commands - , ("i", ChangeMode InsertMode) - , ("a", ChangeMode InsertMode <> MotionCommand (GotoRight 1)) + [ ("\x1b", SetCount Nothing) + -- ^TODO RingBell if count is already Nothing + -- TODO cancel any unfinished commands + , ("i", ChangeMode InsertMode <> SetCount Nothing) + , ("a", ChangeMode InsertMode <> SetCount Nothing <> MotionCommand GotoRight) , ("I", ChangeMode InsertMode <> MotionCommand GotoFirstChar) , ("A", ChangeMode InsertMode <> MotionCommand GotoEndOfLine) - , ("0", MotionCommand GotoFirstChar) - , ("$", MotionCommand GotoEndOfLine) - , ("h", MotionCommand $ GotoLeft 1) - , ("l", MotionCommand $ GotoRight 1) - , ("b", MotionCommand $ WordsBackward 1) - , ("w", MotionCommand $ WordsForward 1) - , ("d", ChangeMode DeleteMode) - , ("\"", ChangeMode SelectRegisterMode) - , ("\x1b[C", MotionCommand $ GotoRight 1) - , ("\x1b[D", MotionCommand $ GotoLeft 1) - , ("\x0a", ExecuteInputBuffer <> ChangeMode InsertMode) + , ("|", MotionCommand GotoColumn <> SetCount Nothing) + , ("$", MotionCommand GotoEndOfLine <> SetCount Nothing) + , ("h", MotionCommand GotoLeft <> SetCount Nothing) + , ("l", MotionCommand GotoRight <> SetCount Nothing) + , ("b", MotionCommand WordsBackward <> SetCount Nothing) + , ("w", MotionCommand WordsForward <> SetCount Nothing) + , ("d", ChangeMode DeleteMode <> SetCount Nothing) + , ("\"", ChangeMode SelectRegisterMode <> SetCount Nothing) + , ("\x1b[C", MotionCommand GotoRight <> SetCount Nothing) + , ("\x1b[D", MotionCommand GotoLeft <> SetCount Nothing) + , ("\x0a", ExecuteInputBuffer <> ChangeMode InsertMode <> SetCount Nothing) ] - ++ (map (\i -> (show i, MulCount 10 <> AddCount i)) [0..9]) + ++ (map (\i -> (show i, AppendCount i)) [0..9]) + -- XXX + -- if we would want 0 to move the cursor to the first character of the + -- line, then we would need ("0", x) + -- where + -- x :: Command + -- x = Embed f + -- f :: VT Command + -- f = gets (isJust . count) >>= + -- return . bool (MotionCommand GotoFirstChar) (AppendCount 0) + -- bool :: a -> a -> Bool -> a + -- bool _ a True = a + -- bool a _ False = a + -- and also we would have to extend data Command by Embed (VT Command) + -- execCommand (Embed a) = a >>= execCommand + -- + -- This all looks quite strange, so just use | if you want that movement... + -- ^_^ imap :: Keymap imap = - [ ("\x1b", ChangeMode NormalMode <> MotionCommand (GotoLeft 1)) + [ ("\x1b", ChangeMode NormalMode <> MotionCommand GotoLeft) , ("\x01", MotionCommand GotoFirstChar) , ("\x05", MotionCommand GotoEndOfLine) , ("\x1b[3~", KillNextChar) - , ("\x1b[C", MotionCommand $ GotoRight 1) - , ("\x1b[D", MotionCommand $ GotoLeft 1) + , ("\x1b[C", MotionCommand GotoRight) + , ("\x1b[D", MotionCommand GotoLeft) , ("\x16", ChangeMode VerbatimMode) -- ^V , ("\x17", KillLastWord) -- ^W , ("\x0a", ExecuteInputBuffer) , ("\x7f", KillLastChar) -- Delete , ("\x08", KillLastChar) -- BackSpace - , ("\x1bOc", MotionCommand $ WordsForward 1) - , ("\x1bOd", MotionCommand $ WordsBackward 1) + , ("\x1bOc", MotionCommand WordsForward) + , ("\x1bOd", MotionCommand WordsBackward) ] @@ -506,12 +530,18 @@ instance Show Mode where getCommand :: Mode -> String -> Command + getCommand InsertMode s = maybe (InsertString s) id $ lookup s imap -getCommand NormalMode s = maybe (AlertBadInput s) id $ lookup s nmap + +getCommand NormalMode s = + maybe (AlertBadInput s <> SetCount Nothing) id $ lookup s nmap + getCommand VerbatimMode s = InsertString s <> ChangeMode InsertMode + getCommand SelectRegisterMode s = maybe (AlertBadInput s) id $ lookup s selectRegisterMap -- ^ TODO clear bad input + getCommand DeleteMode s = maybe (AlertBadInput s) id $ lookup s dmap |