diff options
| -rw-r--r-- | src/Buffer/Motion.hs | 28 | ||||
| -rw-r--r-- | src/Main.hs | 122 |
2 files changed, 90 insertions, 60 deletions
diff --git a/src/Buffer/Motion.hs b/src/Buffer/Motion.hs index 8e59789..b07a45c 100644 --- a/src/Buffer/Motion.hs +++ b/src/Buffer/Motion.hs @@ -78,3 +78,31 @@ move ToEndOfLine _ = gotoEndOfLine -- TODO use count move ToColumn c = gotoColumn c move WordsForward c = wordsForward c move WordsBackward c = wordsBackward c + + +select :: Motion -> Int -> Buffer -> String +select x i b = + if nls' < nls then take (nls - nls') rs' else + if nrs' < nrs then take (nrs - nrs') rs else + "" + where + (ls, rs) = b + (ls', rs') = move x i b + nls = length ls + nls' = length ls' + nrs = length rs + nrs' = length rs' + + +delete :: Motion -> Int -> Buffer -> Buffer +delete x i b = + ( if nls' < nls then ls' else ls + , if nrs' < nrs then rs' else rs + ) + where + (ls, rs) = b + (ls', rs')= move x i b + nls = length ls + nls' = length ls' + nrs = length rs + nrs' = length rs' diff --git a/src/Main.hs b/src/Main.hs index da1141d..11f8fe6 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -10,7 +10,7 @@ import Control.Concurrent import Control.Monad import Data.Char import Data.IORef -import Data.List +import Data.List hiding (delete) import Numeric (showIntAtBase) import System.IO --import System.Posix.Signals @@ -37,6 +37,7 @@ data Mode | VerbatimMode | SelectRegisterMode | DeleteMode + | YankMode deriving (Eq) @@ -153,11 +154,9 @@ data Command = AlertBadInput String | DebugShowVTState | InsertString String - | KillLastWord - | KillLastChar - | KillNextChar | ExecuteInputBuffer | MoveCursor Motion + | MoveCursorLeftIfAtEndOfLine | MoveCursorWarn Motion | ChangeMode Mode -- TODO Move Count Motion @@ -169,9 +168,9 @@ data Command | AppendCount Int | SetCount (Maybe Int) | SetRegister Char + | Delete Motion | DeleteEntireLine - | DeleteLeft - | DeleteRight + | Yank Motion instance Monoid Command where mempty = Nop @@ -241,6 +240,11 @@ execCommand (MoveCursor x) = do whenM (uses mode (==NormalMode) >>&& uses (buffer . _2) null) $ buffer %= gotoLeft 1 +-- TODO merge with mode constraints in MoveCursor +execCommand MoveCursorLeftIfAtEndOfLine = do + whenM (uses (buffer . _2) null) $ + buffer %= gotoLeft 1 + -- TODO Make this "real" warnings, i.e. don't throwError but tell. This -- is required in order to perform any Combine-d commands regardless of -- failed moves. Currently this is only used to SetCount Nothing (which @@ -299,24 +303,6 @@ execCommand ExecuteInputBuffer = do buffer .= emptyBuffer -execCommand KillNextChar = do - whenM (uses (buffer . _2) null) $ - throwError (OtherError "nothing to kill right") - - buffer . _2 %= tail - -execCommand KillLastChar = do - whenM (uses (buffer . _1) null) $ - throwError (OtherError "nothing to kill left") - - buffer . _1 %= init - -execCommand KillLastWord = do - whenM (uses (buffer . _1) null) $ - throwError (OtherError "nothing to kill left") - - buffer . _1 %= foldr dropWhileEnd `flip` [not . isSpace, isSpace] - execCommand (AlertBadInput s) = throwError (UnhandledInputError s) @@ -365,40 +351,24 @@ execCommand DeleteEntireLine = & registers %~ (at r .~ v) . (at defaultRegister .~ v) -execCommand DeleteLeft = - modify $ \q -> do - let c = maybe 1 id $ _count q - r = -- TODO only use "- if we're deleting less than one line - if _register q == defaultRegister - then '-' -- smallDeleteRegister - else _register q - - lhs = fst (_buffer q) - (lhs', y) = splitAt (length lhs - c) lhs - - - q & buffer . _1 .~ lhs' - & register .~ defaultRegister - & registers %~ (at r .~ Just y) - . (at defaultRegister .~ Just y) +-- TODO yank into "- (smallDeleteRegister) when deleting less than one line +-- TODO reset register after this command (q & register .~ defaultRegister) +execCommand (Delete x) = do + b0 <- use buffer + c <- uses count (maybe 1 id) + buffer %= delete x c + b1 <- use buffer -execCommand DeleteRight = - modify $ \q -> do - let c = maybe 1 id $ _count q - r = -- TODO only use "- if we're deleting less than one line - if _register q == defaultRegister - then '-' -- smallDeleteRegister - else _register q + when (b0 == b1) $ throwError (OtherError "nothing to delete") - rhs = snd (_buffer q) - (y, rhs') = splitAt c rhs +-- TODO Yank register motion (after motion has incorporated count) +execCommand (Yank x) = + modify $ \q@VTState{..} -> do + let c = maybe 1 id _count + y = select x c _buffer - q & buffer . _2 .~ rhs' - & register .~ defaultRegister - & registers %~ (at r .~ Just y) - . (at defaultRegister .~ Just y) - + q & registers %~ (at _register .~ Just y) -- XXX assumes that the cursor is already at the (cleared) input line @@ -435,6 +405,7 @@ promptString InsertMode = "> " promptString SelectRegisterMode = "\" " promptString DeleteMode = SGR [31,1] "> " promptString VerbatimMode = SGR [34,1] "^ " +promptString YankMode = SGR [31,1] "y " spans :: (a -> Bool) -> [a] -> [Either [a] [a]] @@ -498,8 +469,24 @@ dmap = [ ("\ESC", ChangeMode NormalMode <> SetCount Nothing) , ("\ESC[24~", DebugShowVTState) , ("d", DeleteEntireLine <> ChangeMode NormalMode <> SetCount Nothing) - , ("h", DeleteLeft <> ChangeMode NormalMode <> SetCount Nothing) - , ("l", DeleteRight <> ChangeMode NormalMode <> SetCount Nothing) + , ("$", Yank ToEndOfLine <> + Delete ToEndOfLine <> + ChangeMode NormalMode <> + SetCount Nothing <> + MoveCursorLeftIfAtEndOfLine + ) + , ("0", Yank ToStartOfLine <> + Delete ToStartOfLine <> + ChangeMode NormalMode <> SetCount Nothing) + , ("h", Yank CharsBackward <> + Delete CharsBackward <> + ChangeMode NormalMode <> SetCount Nothing) + , ("l", Yank CharsForward <> + Delete CharsForward <> + ChangeMode NormalMode <> + SetCount Nothing <> + MoveCursorLeftIfAtEndOfLine + ) ] @@ -534,6 +521,7 @@ nmap = , ("b", MoveCursorWarn WordsBackward <> SetCount Nothing) , ("w", MoveCursorWarn WordsForward <> SetCount Nothing) , ("d", ChangeMode DeleteMode) + , ("y", ChangeMode YankMode) , ("\"", ChangeMode SelectRegisterMode <> SetCount Nothing) , ("\ESC[24~", DebugShowVTState) , ("\ESC[C", MoveCursorWarn CharsForward <> SetCount Nothing) @@ -566,18 +554,29 @@ imap = , ("\x01", MoveCursorWarn ToStartOfLine) , ("\x05", MoveCursorWarn ToEndOfLine) , ("\ESC[24~", DebugShowVTState) - , ("\ESC[3~", KillNextChar) + , ("\ESC[3~", Delete CharsForward) , ("\ESC[C", MoveCursorWarn CharsForward) , ("\ESC[D", MoveCursorWarn CharsBackward) , ("\x16", ChangeMode VerbatimMode) -- ^V - , ("\x17", KillLastWord) -- ^W + , ("\x17", Delete WordsBackward) -- ^W , ("\x0a", ExecuteInputBuffer) - , ("\x7f", KillLastChar) -- Delete - , ("\x08", KillLastChar) -- BackSpace + , ("\x7f", Delete CharsBackward) -- Delete + , ("\x08", Delete CharsBackward) -- BackSpace , ("\ESCOc", MoveCursorWarn WordsForward) , ("\ESCOd", MoveCursorWarn WordsBackward) ] +ymap :: Keymap +ymap = + [ ("\ESC", ChangeMode NormalMode <> SetCount Nothing) + , ("\ESC[24~", DebugShowVTState) + -- TODO , ("y", DeleteEntireLine <> ChangeMode NormalMode <> SetCount Nothing) + , ("$", Yank ToEndOfLine <> ChangeMode NormalMode <> SetCount Nothing) + , ("0", Yank ToStartOfLine <> ChangeMode NormalMode <> SetCount Nothing) + , ("h", Yank CharsBackward <> ChangeMode NormalMode <> SetCount Nothing) + , ("l", Yank CharsForward <> ChangeMode NormalMode <> SetCount Nothing) + ] + type Keymap = [(String, Command)] @@ -587,6 +586,7 @@ instance Show Mode where show VerbatimMode = "verbatim" show SelectRegisterMode = "select register" show DeleteMode = "delete" + show YankMode = "yank" getCommand :: Mode -> String -> Command @@ -604,6 +604,8 @@ getCommand SelectRegisterMode s = getCommand DeleteMode s = maybe (AlertBadInput s) id $ lookup s dmap +getCommand YankMode s = maybe (AlertBadInput s) id $ lookup s ymap + -- TODO Control.Monad.whenLeft whenLeft :: Monad m => Either a b -> (a -> m ()) -> m () |