mirror of
https://github.com/fjvallarino/monomer.git
synced 2024-08-16 23:40:54 +03:00
Add support for delete key in inputField and textArea (and fix undo bug) (#294)
* add support for delete key in inputField * add support for delete key in textArea * add unit tests for delete key * fix inputField undo behavior * add more unit tests for textField and textArea
This commit is contained in:
parent
a16e8599df
commit
465f33c460
@ -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) []
|
||||
|
@ -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)
|
||||
|
@ -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]
|
||||
|
@ -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]
|
||||
|
Loading…
Reference in New Issue
Block a user