Main: add Yank

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 ()