summaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Buffer/Motion.hs38
-rw-r--r--src/Main.hs90
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