diff --git a/src/Monomer/Widgets/Singles/Base/InputField.hs b/src/Monomer/Widgets/Singles/Base/InputField.hs index 90b6698b..1aa79d6e 100644 --- a/src/Monomer/Widgets/Singles/Base/InputField.hs +++ b/src/Monomer/Widgets/Singles/Base/InputField.hs @@ -321,9 +321,11 @@ makeInputField !config !state = widget where handleKeyPress wenv mod code | isDelBackWordNoSel && editable = Just $ moveCursor removeWord prevWordStartIdx Nothing - | isDelBackWord && editable = Just $ moveCursor removeText minTpSel Nothing + | isDelForwardWordNoSel && editable = Just $ moveCursor removeWordF tp Nothing + | isDelWord && editable = Just $ moveCursor removeText minTpSel Nothing | isBackspace && emptySel && editable = Just $ moveCursor removeText (tp - 1) Nothing - | isBackspace && editable = Just $ moveCursor removeText minTpSel Nothing + | isDelete && emptySel && editable = Just $ moveCursor removeTextF tp Nothing + | (isBackspace || isDelete) && editable = Just $ moveCursor removeText minTpSel Nothing | isMoveLeft = Just $ moveCursor txt (tp - 1) Nothing | isMoveRight = Just $ moveCursor txt (tp + 1) Nothing | isMoveWordL = Just $ moveCursor txt prevWordStartIdx Nothing @@ -369,8 +371,12 @@ makeInputField !config !state = widget where | isMacOS wenv = _kmLeftGUI mod | otherwise = _kmLeftCtrl mod isBackspace = isKeyBackspace code && (tp > 0 || isJust currSel) + isDelete = isKeyDelete code && (tp < T.length currText || isJust currSel) isDelBackWord = isBackspace && isWordMod + isDelForwardWord = isDelete && isWordMod isDelBackWordNoSel = isDelBackWord && emptySel + isDelForwardWordNoSel = isDelForwardWord && emptySel + isDelWord = isDelBackWord || isDelForwardWord isMove = not isShift && not isWordMod && not isLineMod isMoveWord = not isShift && isWordMod && not isLineMod isMoveLine = not isShift && isLineMod && not isWordMod @@ -395,9 +401,15 @@ makeInputField !config !state = widget where removeText | isJust currSel = replaceText txt "" | otherwise = T.init part1 <> part2 + removeTextF + | isJust currSel = replaceText txt "" + | otherwise = part1 <> T.tail part2 removeWord | isJust currSel = replaceText txt "" | otherwise = prevWordStart <> part2 + removeWordF + | isJust currSel = replaceText txt "" + | otherwise = part1 <> nextWordEnd moveCursor txt newPos newSel | isJust currSel && isNothing newSel = (txt, fixedPos, Nothing) | isJust currSel && Just fixedPos == currSel = (txt, fixedPos, Nothing) @@ -626,8 +638,8 @@ makeInputField !config !state = widget where _ifsHistIdx = histIdx + 1 } | otherwise = tempState { - _ifsHistory = Seq.take (histIdx - 1) history |> newStep, - _ifsHistIdx = histIdx + _ifsHistory = Seq.take histIdx history |> newStep, + _ifsHistIdx = histIdx + 1 } !newNode = node & L.widget .~ makeInputField config newState @@ -822,11 +834,11 @@ moveHistory wenv node state config steps = result where currHistIdx = _ifsHistIdx state lenHistory = length currHistory reqHistIdx - | steps == -1 && currHistIdx == lenHistory = currHistIdx - 2 + | steps == -1 && currHistIdx == lenHistory = currHistIdx - 1 | otherwise = currHistIdx + steps - histStep = Seq.lookup reqHistIdx currHistory + histStep = Seq.lookup (reqHistIdx - 1) currHistory result - | null currHistory || reqHistIdx < 0 = Just (createResult historyStep) + | null currHistory || reqHistIdx <= 0 = Just (createResult historyStep) | otherwise = fmap createResult histStep createResult histStep = resultReqsEvts newNode reqs evts where (reqs, evts) = genReqsEvents node config state (_ihsText histStep) [] diff --git a/src/Monomer/Widgets/Singles/TextArea.hs b/src/Monomer/Widgets/Singles/TextArea.hs index e32bd7e2..586b7955 100644 --- a/src/Monomer/Widgets/Singles/TextArea.hs +++ b/src/Monomer/Widgets/Singles/TextArea.hs @@ -330,9 +330,11 @@ makeTextArea !wdata !config !state = widget where handleKeyPress wenv mod code | isDelBackWordNoSel && editable = Just removeWordL - | isDelBackWord && editable = Just (replaceText state selStart "") + | isDelForwardWordNoSel && editable = Just removeWordR + | isDelWord && editable = Just (replaceText state selStart "") | isBackspace && emptySel && editable = Just removeCharL - | isBackspace && editable = Just (replaceText state selStart "") + | isDelete && emptySel && editable = Just removeCharR + | (isBackspace || isDelete) && editable = Just (replaceText state selStart "") | isMoveLeft = Just $ moveCursor txt (tpX - 1, tpY) Nothing | isMoveRight = Just $ moveCursor txt (tpX + 1, tpY) Nothing | isMoveUp = Just $ moveCursor txt (tpX, tpY - 1) Nothing @@ -416,8 +418,12 @@ makeTextArea !wdata !config !state = widget where | otherwise = _kmLeftCtrl mod isBackspace = isKeyBackspace code + isDelete = isKeyDelete code isDelBackWord = isBackspace && isWordMod + isDelForwardWord = isDelete && isWordMod isDelBackWordNoSel = isDelBackWord && emptySel + isDelForwardWordNoSel = isDelForwardWord && emptySel + isDelWord = isDelBackWord || isDelForwardWord isMove = not isShift && not isWordMod && not isLineMod isMoveWord = not isShift && isWordMod && not isLineMod @@ -463,7 +469,12 @@ makeTextArea !wdata !config !state = widget where removeCharL | tpX > 0 = replaceFix (tpX - 1, tpY) "" | otherwise = replaceFix (lineLen (tpY - 1), tpY - 1) "" + removeCharR + | tpX < lineLen tpY = replaceFix (tpX + 1, tpY) "" + | tpY >= length textLines - 1 = replaceFix (tpX, tpY) "" + | otherwise = replaceFix (0, tpY + 1) "" removeWordL = replaceFix prevWordPos "" + removeWordR = replaceFix nextWordPos "" moveCursor txt newPos newSel | isJust selStart && isNothing newSel = (txt, fixedPos, Nothing) | isJust selStart && Just fixedPos == selStart = (txt, fixedPos, Nothing) diff --git a/test/unit/Monomer/Widgets/Singles/TextAreaSpec.hs b/test/unit/Monomer/Widgets/Singles/TextAreaSpec.hs index 3159b47e..e9fa2b97 100644 --- a/test/unit/Monomer/Widgets/Singles/TextAreaSpec.hs +++ b/test/unit/Monomer/Widgets/Singles/TextAreaSpec.hs @@ -18,7 +18,7 @@ module Monomer.Widgets.Singles.TextAreaSpec (spec) where import Control.Lens ((&), (^.), (.~)) import Control.Lens.TH (abbreviatedFields, makeLensesWith) import Data.Default -import Data.Text (Text) +import Data.Text (Text, pack) import Test.Hspec import qualified Data.Sequence as Seq @@ -64,6 +64,10 @@ handleEvent = describe "handleEvent" $ do let steps = [evtT "ababa", moveCharL, moveCharL, evtK keyBackspace, evtT "c"] model steps ^. textValue `shouldBe` "abcba" + it "should input 'ababa' and remove the middle 'a'" $ do + let steps = [evtT "ababa", moveCharL, moveCharL, moveCharL, evtK keyDelete] + model steps ^. textValue `shouldBe` "abba" + it "should input 'ababa', select last two and input 'c'" $ do let steps = [evtT "ababa", selCharL, selCharL, selCharL, evtT "c"] model steps ^. textValue `shouldBe` "abc" @@ -291,6 +295,14 @@ handleEventHistory = describe "handleEventHistory" $ do model steps2 ^. textValue `shouldBe` "This is text" lastEvt steps2 `shouldBe` TextChanged "This is text" + it "should input 'This is text', have the middle word removed and then undo" $ do + let str = "This is text" + let steps1 = [evtT str] ++ (replicate 8 moveCharL) ++ [evtKA keyDelete] + let steps2 = steps1 ++ [evtKG keyZ] + model steps1 ^. textValue `shouldBe` "This text" + model steps2 ^. textValue `shouldBe` "This is text" + lastEvt steps2 `shouldBe` TextChanged "This is text" + it "should input 'This is text', have the last two words removed, undo and redo" $ do let str = "This is text" let steps1 = [evtT str, evtKA keyBackspace, evtKA keyBackspace] @@ -299,7 +311,7 @@ handleEventHistory = describe "handleEventHistory" $ do model steps2 ^. textValue `shouldBe` "This is " lastEvt steps2 `shouldBe` TextChanged "This is " - it "should input 'This is just a string', play around with history and come end up with 'This is just text" $ do + it "should input 'This is just a string', play around with history and end up with 'This is just text'" $ do let str = "This is just a string" let steps1 = [evtT str, evtKA keyBackspace, evtKA keyBackspace, evtKA keyBackspace, evtKA keyBackspace, evtKA keyBackspace] let steps2 = steps1 ++ [evtKG keyZ, evtKG keyZ, evtKG keyZ, evtKG keyZ, evtKG keyZ, evtKGS keyZ, evtKGS keyZ, evtT "text"] @@ -315,6 +327,21 @@ handleEventHistory = describe "handleEventHistory" $ do model steps2 ^. textValue `shouldBe` "This is not" lastEvt steps2 `shouldBe` TextChanged "This is not" + it "should input 'This is text', undo to the beginning, input 'text', do one undo and end up with 'tex'" $ do + let str = "This is text" + let steps1 = (evtT . pack . pure <$> str) ++ (replicate 12 $ evtKG keyZ) + let steps2 = steps1 ++ [evtT "t", evtT "e", evtT "x", evtT "t", evtKG keyZ] + model steps1 ^. textValue `shouldBe` "" + model steps2 ^. textValue `shouldBe` "tex" + lastEvt steps2 `shouldBe` TextChanged "tex" + + it "should input 'qwe', undo, input 'e', undo and end up with 'qw'" $ do + let steps1 = [evtT "q", evtT "w", evtT "e", evtKG keyZ] + let steps2 = steps1 ++ [evtT "e", evtKG keyZ] + model steps1 ^. textValue `shouldBe` "qw" + model steps2 ^. textValue `shouldBe` "qw" + lastEvt steps2 `shouldBe` TextChanged "qw" + where wenv = mockWenv (TestModel "") txtCfg = [onChange TextChanged, selectOnFocus, onFocus GotFocus, onBlur LostFocus] diff --git a/test/unit/Monomer/Widgets/Singles/TextFieldSpec.hs b/test/unit/Monomer/Widgets/Singles/TextFieldSpec.hs index e6007c82..8ce8f706 100644 --- a/test/unit/Monomer/Widgets/Singles/TextFieldSpec.hs +++ b/test/unit/Monomer/Widgets/Singles/TextFieldSpec.hs @@ -18,7 +18,7 @@ module Monomer.Widgets.Singles.TextFieldSpec (spec) where import Control.Lens ((&), (^.), (.~)) import Control.Lens.TH (abbreviatedFields, makeLensesWith) import Data.Default -import Data.Text (Text) +import Data.Text (Text, pack) import Test.Hspec import qualified Data.Sequence as Seq @@ -66,6 +66,10 @@ handleEvent = describe "handleEvent" $ do let steps = [evtT "ababa", moveCharL, moveCharL, evtK keyBackspace, evtT "c"] model steps ^. textValue `shouldBe` "abcba" + it "should input 'ababa' and remove the middle 'a'" $ do + let steps = [evtT "ababa", moveCharL, moveCharL, moveCharL, evtK keyDelete] + model steps ^. textValue `shouldBe` "abba" + it "should input 'ababa', select last two and input 'c'" $ do let steps = [evtT "ababa", selCharL, selCharL, selCharL, evtT "c"] model steps ^. textValue `shouldBe` "abc" @@ -238,6 +242,14 @@ handleEventHistory = describe "handleEventHistory" $ do model steps2 ^. textValue `shouldBe` "This is text" lastEvt steps2 `shouldBe` TextChanged "This is text" + it "should input 'This is text', have the middle word removed and then undo" $ do + let str = "This is text" + let steps1 = [evtT str] ++ (replicate 8 moveCharL) ++ [evtKA keyDelete] + let steps2 = steps1 ++ [evtKG keyZ] + model steps1 ^. textValue `shouldBe` "This text" + model steps2 ^. textValue `shouldBe` "This is text" + lastEvt steps2 `shouldBe` TextChanged "This is text" + it "should input 'This is text', have the last two words removed, undo and redo" $ do let str = "This is text" let steps1 = [evtT str, evtKA keyBackspace, evtKA keyBackspace] @@ -246,7 +258,7 @@ handleEventHistory = describe "handleEventHistory" $ do model steps2 ^. textValue `shouldBe` "This is " lastEvt steps2 `shouldBe` TextChanged "This is " - it "should input 'This is just a string', play around with history and come end up with 'This is just text" $ do + it "should input 'This is just a string', play around with history and end up with 'This is just text'" $ do let str = "This is just a string" let steps1 = [evtT str, evtKA keyBackspace, evtKA keyBackspace, evtKA keyBackspace, evtKA keyBackspace, evtKA keyBackspace] let steps2 = steps1 ++ [evtKG keyZ, evtKG keyZ, evtKG keyZ, evtKG keyZ, evtKG keyZ, evtKGS keyZ, evtKGS keyZ, evtT "text"] @@ -262,6 +274,21 @@ handleEventHistory = describe "handleEventHistory" $ do model steps2 ^. textValue `shouldBe` "This is not" lastEvt steps2 `shouldBe` TextChanged "This is not" + it "should input 'This is text', undo to the beginning, input 'text', do one undo and end up with 'tex'" $ do + let str = "This is text" + let steps1 = (evtT . pack . pure <$> str) ++ (replicate 12 $ evtKG keyZ) + let steps2 = steps1 ++ [evtT "t", evtT "e", evtT "x", evtT "t", evtKG keyZ] + model steps1 ^. textValue `shouldBe` "" + model steps2 ^. textValue `shouldBe` "tex" + lastEvt steps2 `shouldBe` TextChanged "tex" + + it "should input 'qwe', undo, input 'e', undo and end up with 'qw'" $ do + let steps1 = [evtT "q", evtT "w", evtT "e", evtKG keyZ] + let steps2 = steps1 ++ [evtT "e", evtKG keyZ] + model steps1 ^. textValue `shouldBe` "qw" + model steps2 ^. textValue `shouldBe` "qw" + lastEvt steps2 `shouldBe` TextChanged "qw" + where wenv = mockWenv (TestModel "") txtCfg = [onChange TextChanged, selectOnFocus, onFocus GotFocus, onBlur LostFocus]