fjvallarino/monomer
1
1
Fork 0
mirror of https://github.com/fjvallarino/monomer.git synced 2024-07-14 15:20:40 +03:00
Code Issues Projects Releases Wiki Activity

Add support for delete key in inputField and textArea (and fix undo bug) (#294)

Browse Source 
* 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:
Ruslan Gadeev 2024-03-21 05:26:22 +03:00 committed by GitHub
parent a16e8599df
commit 465f33c460
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
4 changed files with 90 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
src/Monomer/Widgets/Singles/Base/InputField.hs
View File

@ -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) []

15
src/Monomer/Widgets/Singles/TextArea.hs
View File

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

31
test/unit/Monomer/Widgets/Singles/TextAreaSpec.hs
View File

@ -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]

31
test/unit/Monomer/Widgets/Singles/TextFieldSpec.hs
View File

@ -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]