From 5b56ea881ca2c0cd9cfd4a326e57f184b72e6051 Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Tue, 22 Sep 2020 22:07:27 +0200 Subject: [PATCH] Use Ctrl modifier when navigating in item detail Otherwise it clashes with input fields --- .../src/main/elm/Comp/ItemDetail/Model.elm | 6 +- .../src/main/elm/Comp/ItemDetail/Update.elm | 59 ++++----- .../src/main/elm/Comp/ItemDetail/View.elm | 15 ++- modules/webapp/src/main/elm/Comp/KeyInput.elm | 116 ++++++++++++++++++ modules/webapp/src/main/elm/Util/Html.elm | 24 ++++ 5 files changed, 181 insertions(+), 39 deletions(-) create mode 100644 modules/webapp/src/main/elm/Comp/KeyInput.elm diff --git a/modules/webapp/src/main/elm/Comp/ItemDetail/Model.elm b/modules/webapp/src/main/elm/Comp/ItemDetail/Model.elm index f17990a1..949f043e 100644 --- a/modules/webapp/src/main/elm/Comp/ItemDetail/Model.elm +++ b/modules/webapp/src/main/elm/Comp/ItemDetail/Model.elm @@ -25,6 +25,7 @@ import Comp.DetailEdit import Comp.Dropdown import Comp.Dropzone import Comp.ItemMail +import Comp.KeyInput import Comp.MarkdownInput import Comp.SentMails import Comp.YesNoDimmer @@ -40,7 +41,6 @@ import Http import Page exposing (Page(..)) import Set exposing (Set) import Throttle exposing (Throttle) -import Util.Html exposing (KeyCode) import Util.Tag @@ -86,6 +86,7 @@ type alias Model = , attachDD : DD.Model String String , modalEdit : Maybe Comp.DetailEdit.Model , attachRename : Maybe AttachmentRename + , keyInputModel : Comp.KeyInput.Model } @@ -185,6 +186,7 @@ emptyModel = , attachDD = DD.init , modalEdit = Nothing , attachRename = Nothing + , keyInputModel = Comp.KeyInput.init } @@ -266,7 +268,7 @@ type Msg | ResetHiddenMsg Field (Result Http.Error BasicResult) | SaveNameResp (Result Http.Error BasicResult) | UpdateThrottle - | KeyPress (Maybe KeyCode) + | KeyInputMsg Comp.KeyInput.Msg type SaveNameState diff --git a/modules/webapp/src/main/elm/Comp/ItemDetail/Update.elm b/modules/webapp/src/main/elm/Comp/ItemDetail/Update.elm index 7a3da2c0..395f15f1 100644 --- a/modules/webapp/src/main/elm/Comp/ItemDetail/Update.elm +++ b/modules/webapp/src/main/elm/Comp/ItemDetail/Update.elm @@ -28,12 +28,13 @@ import Comp.ItemDetail.Model , isEditNotes ) import Comp.ItemMail +import Comp.KeyInput import Comp.MarkdownInput import Comp.OrgForm import Comp.PersonForm import Comp.SentMails import Comp.YesNoDimmer -import Data.Direction exposing (Direction) +import Data.Direction import Data.Fields exposing (Field) import Data.Flags exposing (Flags) import Data.ItemNav exposing (ItemNav) @@ -51,7 +52,6 @@ import Throttle import Time import Util.File exposing (makeFileId) import Util.Folder exposing (mkFolderOption) -import Util.Html exposing (KeyCode(..)) import Util.Http import Util.List import Util.Maybe @@ -1230,40 +1230,41 @@ update key flags inav settings msg model = in withSub ( { model | nameSaveThrottle = newThrottle }, cmd ) - KeyPress n -> - case n of - Just Letter_C -> - if model.item.state == "created" then - update key flags inav settings ConfirmItem model + KeyInputMsg lm -> + let + ( km, keys ) = + Comp.KeyInput.update lm model.keyInputModel - else - noSub ( model, Cmd.none ) + model_ = + { model | keyInputModel = km } + in + if keys == Just Comp.KeyInput.ctrlC then + if model.item.state == "created" then + update key flags inav settings ConfirmItem model_ - Just Letter_U -> - if model.item.state /= "created" then - update key flags inav settings UnconfirmItem model + else + update key flags inav settings UnconfirmItem model_ - else - noSub ( model, Cmd.none ) + else if keys == Just Comp.KeyInput.ctrlPoint then + case inav.next of + Just id -> + noSub ( model_, Page.set key (ItemDetailPage id) ) - Just Point -> - case inav.next of - Just id -> - noSub ( model, Page.set key (ItemDetailPage id) ) + Nothing -> + noSub ( model_, Cmd.none ) - Nothing -> - noSub ( model, Cmd.none ) + else if keys == Just Comp.KeyInput.ctrlComma then + case inav.prev of + Just id -> + noSub ( model_, Page.set key (ItemDetailPage id) ) - Just Comma -> - case inav.prev of - Just id -> - noSub ( model, Page.set key (ItemDetailPage id) ) + Nothing -> + noSub ( model_, Cmd.none ) - Nothing -> - noSub ( model, Cmd.none ) - - _ -> - noSub ( model, Cmd.none ) + else + -- withSub because the keypress may be inside the name + -- field and requires to activate the throttle + withSub ( model_, Cmd.none ) diff --git a/modules/webapp/src/main/elm/Comp/ItemDetail/View.elm b/modules/webapp/src/main/elm/Comp/ItemDetail/View.elm index 52c77232..4be58ea3 100644 --- a/modules/webapp/src/main/elm/Comp/ItemDetail/View.elm +++ b/modules/webapp/src/main/elm/Comp/ItemDetail/View.elm @@ -8,6 +8,7 @@ import Comp.Dropdown import Comp.Dropzone import Comp.ItemDetail.Model exposing (Model, Msg(..), NotesField(..), SaveNameState(..)) import Comp.ItemMail +import Comp.KeyInput import Comp.MarkdownInput import Comp.SentMails import Comp.YesNoDimmer @@ -28,7 +29,6 @@ import Page exposing (Page(..)) import Set import Util.File exposing (makeFileId) import Util.Folder -import Util.Html exposing (onKeyUpCode) import Util.List import Util.Maybe import Util.Size @@ -39,8 +39,7 @@ import Util.Time view : ItemNav -> UiSettings -> Model -> Html Msg view inav settings model = div - [ onKeyUpCode KeyPress - ] + [] [ renderItemInfo settings model , renderDetailMenu inav model , renderMailForm settings model @@ -113,7 +112,7 @@ renderDetailMenu inav model = , Maybe.map ItemDetailPage inav.prev |> Maybe.map Page.href |> Maybe.withDefault (href "#") - , title "Previous item. Key ','" + , title "Previous item. Key 'Ctrl-,'" ] [ i [ class "caret square left outline icon" ] [] ] @@ -125,7 +124,7 @@ renderDetailMenu inav model = , Maybe.map ItemDetailPage inav.next |> Maybe.map Page.href |> Maybe.withDefault (href "#") - , title "Next item. Key '.'" + , title "Next item. Key 'Ctrl-.'" ] [ i [ class "caret square right outline icon" ] [] ] @@ -709,7 +708,7 @@ renderTags settings model = renderEditMenu : UiSettings -> Model -> List (Html Msg) renderEditMenu settings model = [ Html.map ModalEditMsg (Comp.DetailEdit.viewModal settings model.modalEdit) - , div [] + , div (Comp.KeyInput.eventsM KeyInputMsg) [ renderEditButtons model , renderEditForm settings model ] @@ -724,7 +723,7 @@ renderEditButtons model = [ ( "borderless item", True ) , ( "invisible", model.item.state /= "created" ) ] - , title "Confirm metadata. Key 'c'." + , title "Confirm metadata. Key 'Ctrl-c'." , href "#" , onClick ConfirmItem ] @@ -736,7 +735,7 @@ renderEditButtons model = , ( "invisible", model.item.state /= "confirmed" ) ] , href "#" - , title "Unconfirm metadata. Key 'u'." + , title "Unconfirm metadata. Key 'Ctrl-c'." , onClick UnconfirmItem ] [ i [ class "eye slash outline icon" ] [] diff --git a/modules/webapp/src/main/elm/Comp/KeyInput.elm b/modules/webapp/src/main/elm/Comp/KeyInput.elm new file mode 100644 index 00000000..e46d47b0 --- /dev/null +++ b/modules/webapp/src/main/elm/Comp/KeyInput.elm @@ -0,0 +1,116 @@ +module Comp.KeyInput exposing + ( KeyInput + , Model + , Msg + , ctrlC + , ctrlComma + , ctrlN + , ctrlPoint + , ctrlU + , events + , eventsM + , init + , update + ) + +import Html exposing (Attribute) +import Html.Attributes +import Util.Html exposing (KeyCode(..)) + + +type alias KeyInput = + { down : List KeyCode + , up : KeyCode + } + + +ctrlPlus : KeyCode -> KeyInput +ctrlPlus code = + { down = [ Ctrl ] + , up = code + } + + +ctrlN : KeyInput +ctrlN = + ctrlPlus Letter_N + + +ctrlC : KeyInput +ctrlC = + ctrlPlus Letter_C + + +ctrlU : KeyInput +ctrlU = + ctrlPlus Letter_U + + +ctrlPoint : KeyInput +ctrlPoint = + ctrlPlus Point + + +ctrlComma : KeyInput +ctrlComma = + ctrlPlus Comma + + +type alias Model = + List KeyCode + + +init : Model +init = + [] + + +type Msg + = KeyDown (Maybe KeyCode) + | KeyUp (Maybe KeyCode) + + +events : List (Attribute Msg) +events = + [ Util.Html.onKeyUpCode KeyUp + , Util.Html.onKeyDownCode KeyDown + ] + + +eventsM : (Msg -> msg) -> List (Attribute msg) +eventsM tagger = + List.map (Html.Attributes.map tagger) events + + +update : Msg -> Model -> ( Model, Maybe KeyInput ) +update msg model = + case msg of + KeyDown (Just code) -> + ( insert code model, Nothing ) + + KeyUp (Just code) -> + let + m_ = + remove code model + in + ( m_, Just <| KeyInput m_ code ) + + KeyDown Nothing -> + ( model, Nothing ) + + KeyUp Nothing -> + ( model, Nothing ) + + +insert : a -> List a -> List a +insert el list = + if List.member el list then + list + + else + el :: list + + +remove : a -> List a -> List a +remove el list = + List.filter (\e -> e /= el) list diff --git a/modules/webapp/src/main/elm/Util/Html.elm b/modules/webapp/src/main/elm/Util/Html.elm index 38678f09..e47f8498 100644 --- a/modules/webapp/src/main/elm/Util/Html.elm +++ b/modules/webapp/src/main/elm/Util/Html.elm @@ -8,6 +8,8 @@ module Util.Html exposing , onDragLeave , onDragOver , onDropFiles + , onKeyDown + , onKeyDownCode , onKeyUp , onKeyUpCode ) @@ -56,12 +58,24 @@ type KeyCode | Letter_U | Point | Comma + | Shift + | Ctrl + | Super | Code Int intToKeyCode : Int -> Maybe KeyCode intToKeyCode code = case code of + 16 -> + Just Shift + + 17 -> + Just Ctrl + + 91 -> + Just Super + 38 -> Just Up @@ -122,11 +136,21 @@ onKeyUp tagger = on "keyup" (D.map tagger keyCode) +onKeyDown : (Int -> msg) -> Attribute msg +onKeyDown tagger = + on "keydown" (D.map tagger keyCode) + + onKeyUpCode : (Maybe KeyCode -> msg) -> Attribute msg onKeyUpCode tagger = onKeyUp (intToKeyCode >> tagger) +onKeyDownCode : (Maybe KeyCode -> msg) -> Attribute msg +onKeyDownCode tagger = + onKeyDown (intToKeyCode >> tagger) + + onClickk : msg -> Attribute msg onClickk msg = Html.Events.preventDefaultOn "click" (D.map alwaysPreventDefault (D.succeed msg))