summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authortv <tv@krebsco.de>2017-08-07 01:34:00 +0200
committertv <tv@krebsco.de>2017-08-07 01:34:00 +0200
commit9c2d648916f1a62fc429527bae610f71967843ea (patch)
treee734e5fa1229bcb23fdbd904fe83999725fb7446
parent5e9ee547af994a88da8bbaa638c3e94f16795aac (diff)
Main: add Yank
-rw-r--r--src/Buffer/Motion.hs28
-rw-r--r--src/Main.hs122
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 ()