From 22d70b499755ad3b4c3520986d52dca4bebade45 Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Mon, 21 Sep 2020 23:27:09 +0200 Subject: [PATCH 1/5] Allow keyboard navigation in FixedDropdown --- .../src/main/elm/Comp/FixedDropdown.elm | 112 +++++++++++++++++- modules/webapp/src/main/elm/Util/Html.elm | 33 +++++- 2 files changed, 139 insertions(+), 6 deletions(-) diff --git a/modules/webapp/src/main/elm/Comp/FixedDropdown.elm b/modules/webapp/src/main/elm/Comp/FixedDropdown.elm index 079545a5..4ed9f162 100644 --- a/modules/webapp/src/main/elm/Comp/FixedDropdown.elm +++ b/modules/webapp/src/main/elm/Comp/FixedDropdown.elm @@ -15,6 +15,8 @@ module Comp.FixedDropdown exposing import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) +import Util.Html exposing (KeyCode(..), onKeyUpCode) +import Util.List type alias Item a = @@ -26,18 +28,21 @@ type alias Item a = type alias Model a = { options : List (Item a) , menuOpen : Bool + , selected : Maybe a } type Msg a = SelectItem (Item a) | ToggleMenu + | KeyPress (Maybe KeyCode) init : List (Item a) -> Model a init options = { options = options , menuOpen = False + , selected = Nothing } @@ -60,6 +65,54 @@ initTuple tuples = init <| List.map mkItem tuples +isSelected : Model a -> Item a -> Bool +isSelected model item = + model.selected == Just item.id + + +movePrevious : Model a -> ( Model a, Maybe a ) +movePrevious model = + let + prev = + Util.List.findPrev (isSelected model) model.options + in + case prev of + Just p -> + ( { model | selected = Just p.id, menuOpen = True }, Nothing ) + + Nothing -> + ( { model + | selected = + List.reverse model.options + |> List.head + |> Maybe.map .id + , menuOpen = True + } + , Nothing + ) + + +moveNext : Model a -> ( Model a, Maybe a ) +moveNext model = + let + next = + Util.List.findNext (isSelected model) model.options + in + case next of + Just n -> + ( { model | selected = Just n.id, menuOpen = True }, Nothing ) + + Nothing -> + ( { model + | selected = + List.head model.options + |> Maybe.map .id + , menuOpen = True + } + , Nothing + ) + + update : Msg a -> Model a -> ( Model a, Maybe a ) update msg model = case msg of @@ -69,6 +122,49 @@ update msg model = SelectItem item -> ( model, Just item.id ) + KeyPress (Just Space) -> + update ToggleMenu model + + KeyPress (Just Enter) -> + if not model.menuOpen then + update ToggleMenu model + + else + let + selected = + Util.List.find (isSelected model) model.options + in + case selected of + Just i -> + ( { model | menuOpen = False }, Just i.id ) + + Nothing -> + ( model, Nothing ) + + KeyPress (Just Up) -> + movePrevious model + + KeyPress (Just Letter_P) -> + movePrevious model + + KeyPress (Just Letter_K) -> + movePrevious model + + KeyPress (Just Down) -> + moveNext model + + KeyPress (Just Letter_N) -> + moveNext model + + KeyPress (Just Letter_J) -> + moveNext model + + KeyPress (Just ESC) -> + ( { model | menuOpen = False }, Nothing ) + + KeyPress _ -> + ( model, Nothing ) + viewStyled : String -> Maybe (Item a) -> Model a -> Html (Msg a) viewStyled classes selected model = @@ -78,7 +174,9 @@ viewStyled classes selected model = , ( classes, True ) , ( "open", model.menuOpen ) ] + , tabindex 0 , onClick ToggleMenu + , onKeyUpCode KeyPress ] [ input [ type_ "hidden" ] [] , i [ class "dropdown icon" ] [] @@ -100,7 +198,7 @@ viewStyled classes selected model = ] ] <| - List.map renderItems model.options + List.map (renderItems model) model.options ] @@ -114,8 +212,14 @@ viewString selected model = view (Maybe.map (\s -> Item s s) selected) model -renderItems : Item a -> Html (Msg a) -renderItems item = - div [ class "item", onClick (SelectItem item) ] +renderItems : Model a -> Item a -> Html (Msg a) +renderItems model item = + div + [ classList + [ ( "item", True ) + , ( "selected", isSelected model item ) + ] + , onClick (SelectItem item) + ] [ text item.display ] diff --git a/modules/webapp/src/main/elm/Util/Html.elm b/modules/webapp/src/main/elm/Util/Html.elm index 7649fa46..fa56a8f1 100644 --- a/modules/webapp/src/main/elm/Util/Html.elm +++ b/modules/webapp/src/main/elm/Util/Html.elm @@ -45,6 +45,14 @@ type KeyCode | Right | Enter | Space + | ESC + | Letter_N + | Letter_P + | Letter_H + | Letter_J + | Letter_K + | Letter_L + | Code Int intToKeyCode : Int -> Maybe KeyCode @@ -68,8 +76,29 @@ intToKeyCode code = 32 -> Just Space - _ -> - Nothing + 27 -> + Just ESC + + 72 -> + Just Letter_H + + 74 -> + Just Letter_J + + 75 -> + Just Letter_K + + 76 -> + Just Letter_L + + 78 -> + Just Letter_N + + 80 -> + Just Letter_P + + n -> + Just (Code n) onKeyUp : (Int -> msg) -> Attribute msg From dc0e05bc20c92047787a72b9f1c6d2f594b36aa2 Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Mon, 21 Sep 2020 23:52:50 +0200 Subject: [PATCH 2/5] Navigate in ugly dropdown with keybord - iterate through options with n,p,j,k - select with enter - remove item with esc - fixes dropdown bug when removing an item, where the menu opens --- modules/webapp/src/main/elm/Comp/Dropdown.elm | 57 ++++++++++++++++--- 1 file changed, 50 insertions(+), 7 deletions(-) diff --git a/modules/webapp/src/main/elm/Comp/Dropdown.elm b/modules/webapp/src/main/elm/Comp/Dropdown.elm index 1a0a0de9..c825fc89 100644 --- a/modules/webapp/src/main/elm/Comp/Dropdown.elm +++ b/modules/webapp/src/main/elm/Comp/Dropdown.elm @@ -313,7 +313,7 @@ isDropdownChangeMsg cm = KeyPress code -> Util.Html.intToKeyCode code - |> Maybe.map (\c -> c == Util.Html.Enter) + |> Maybe.map (\c -> c == Util.Html.Enter || c == Util.Html.ESC) |> Maybe.withDefault False _ -> @@ -352,7 +352,10 @@ update msg model = m = deselectItem model e |> applyFilter "" in - ( { m | menuOpen = False }, Cmd.none ) + ( -- Setting to True, because parent click sets it to False… ugly + { m | menuOpen = True } + , Cmd.none + ) Filter str -> let @@ -369,9 +372,40 @@ update msg model = Just Util.Html.Up -> ( makeNextActive (\n -> n - 1) model, Cmd.none ) + Just Util.Html.Letter_P -> + ( makeNextActive (\n -> n - 1) model, Cmd.none ) + + Just Util.Html.Letter_K -> + ( makeNextActive (\n -> n - 1) model, Cmd.none ) + Just Util.Html.Down -> ( makeNextActive ((+) 1) model, Cmd.none ) + Just Util.Html.Letter_N -> + ( makeNextActive ((+) 1) model, Cmd.none ) + + Just Util.Html.Letter_J -> + ( makeNextActive ((+) 1) model, Cmd.none ) + + Just Util.Html.ESC -> + if model.menuOpen then + ( model, Cmd.none ) + + else + case model.selected of + [ e ] -> + let + ( m_, c_ ) = + update (RemoveItem e) model + in + ( { m_ | menuOpen = False }, c_ ) + + _ -> + ( model, Cmd.none ) + + Just Util.Html.Space -> + update ToggleMenu model + Just Util.Html.Enter -> let m = @@ -404,7 +438,11 @@ viewSingle model = [ class "message" , style "display" "inline-block !important" ] - [ i [ class "delete icon", onClick (RemoveItem item) ] [] + [ i + [ class "delete icon" + , onClick (RemoveItem item) + ] + [] , text item.option.text ] @@ -420,7 +458,6 @@ viewSingle model = [ class "search" , placeholder "Search…" , onInput Filter - , onKeyUp KeyPress , value model.filterString ] [] @@ -433,10 +470,15 @@ viewSingle model = , ( "open", model.menuOpen ) ] :: (if model.menuOpen then - [] + [ tabindex 0 + , onKeyUp KeyPress + ] else - [ onClick ToggleMenu ] + [ onClick ToggleMenu + , tabindex 0 + , onKeyUp KeyPress + ] ) ) (List.append @@ -482,6 +524,8 @@ viewMultiple settings model = [ ( "ui search dropdown multiple selection", True ) , ( "open", model.menuOpen ) ] + , tabindex 0 + , onKeyUp KeyPress ] (List.concat [ [ i [ class "dropdown icon", onClick ToggleMenu ] [] @@ -492,7 +536,6 @@ viewMultiple settings model = [ class "search" , placeholder "Search…" , onInput Filter - , onKeyUp KeyPress , value model.filterString ] [] From 60b8dc2134189ba7e9c3b687aeb0376106b63b61 Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Tue, 22 Sep 2020 00:27:32 +0200 Subject: [PATCH 3/5] Navigate items using keyboard - previous/next item with `.,` - confirm with `c` - unconfirm with `u` --- modules/webapp/src/main/elm/App/Update.elm | 2 +- .../webapp/src/main/elm/Comp/ItemDetail.elm | 5 +- .../src/main/elm/Comp/ItemDetail/Model.elm | 2 + .../src/main/elm/Comp/ItemDetail/Update.elm | 79 ++++++++++++++----- .../src/main/elm/Comp/ItemDetail/View.elm | 16 ++-- modules/webapp/src/main/elm/Data/ItemNav.elm | 7 ++ .../webapp/src/main/elm/Page/Home/Data.elm | 3 +- .../src/main/elm/Page/ItemDetail/Update.elm | 11 +-- .../src/main/elm/Page/ItemDetail/View.elm | 7 +- modules/webapp/src/main/elm/Util/Html.elm | 16 ++++ 10 files changed, 107 insertions(+), 41 deletions(-) create mode 100644 modules/webapp/src/main/elm/Data/ItemNav.elm diff --git a/modules/webapp/src/main/elm/App/Update.elm b/modules/webapp/src/main/elm/App/Update.elm index a7169e7d..9e511809 100644 --- a/modules/webapp/src/main/elm/App/Update.elm +++ b/modules/webapp/src/main/elm/App/Update.elm @@ -195,7 +195,7 @@ updateItemDetail lmsg model = Page.ItemDetail.Update.update model.key model.flags - inav.next + inav model.uiSettings lmsg model.itemDetailModel diff --git a/modules/webapp/src/main/elm/Comp/ItemDetail.elm b/modules/webapp/src/main/elm/Comp/ItemDetail.elm index 4009d1ee..b16d4056 100644 --- a/modules/webapp/src/main/elm/Comp/ItemDetail.elm +++ b/modules/webapp/src/main/elm/Comp/ItemDetail.elm @@ -10,6 +10,7 @@ import Comp.ItemDetail.Model exposing (Msg(..)) import Comp.ItemDetail.Update import Comp.ItemDetail.View exposing (..) import Data.Flags exposing (Flags) +import Data.ItemNav exposing (ItemNav) import Data.UiSettings exposing (UiSettings) import Html exposing (..) import Page exposing (Page(..)) @@ -24,11 +25,11 @@ emptyModel = Comp.ItemDetail.Model.emptyModel -update : Nav.Key -> Flags -> Maybe String -> UiSettings -> Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) +update : Nav.Key -> Flags -> ItemNav -> UiSettings -> Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) update = Comp.ItemDetail.Update.update -view : { prev : Maybe String, next : Maybe String } -> UiSettings -> Model -> Html Msg +view : ItemNav -> UiSettings -> Model -> Html Msg view = Comp.ItemDetail.View.view diff --git a/modules/webapp/src/main/elm/Comp/ItemDetail/Model.elm b/modules/webapp/src/main/elm/Comp/ItemDetail/Model.elm index 1aecb71a..f17990a1 100644 --- a/modules/webapp/src/main/elm/Comp/ItemDetail/Model.elm +++ b/modules/webapp/src/main/elm/Comp/ItemDetail/Model.elm @@ -40,6 +40,7 @@ import Http import Page exposing (Page(..)) import Set exposing (Set) import Throttle exposing (Throttle) +import Util.Html exposing (KeyCode) import Util.Tag @@ -265,6 +266,7 @@ type Msg | ResetHiddenMsg Field (Result Http.Error BasicResult) | SaveNameResp (Result Http.Error BasicResult) | UpdateThrottle + | KeyPress (Maybe KeyCode) 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 d768b0e2..7a3da2c0 100644 --- a/modules/webapp/src/main/elm/Comp/ItemDetail/Update.elm +++ b/modules/webapp/src/main/elm/Comp/ItemDetail/Update.elm @@ -36,6 +36,7 @@ import Comp.YesNoDimmer import Data.Direction exposing (Direction) import Data.Fields exposing (Field) import Data.Flags exposing (Flags) +import Data.ItemNav exposing (ItemNav) import Data.UiSettings exposing (UiSettings) import DatePicker import Dict @@ -50,14 +51,15 @@ 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 import Util.String -update : Nav.Key -> Flags -> Maybe String -> UiSettings -> Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) -update key flags next settings msg model = +update : Nav.Key -> Flags -> ItemNav -> UiSettings -> Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) +update key flags inav settings msg model = case msg of Init -> let @@ -83,7 +85,7 @@ update key flags next settings msg model = ( m1, c1, s1 ) = update key flags - next + inav settings (TagDropdownMsg (Comp.Dropdown.SetSelection item.tags)) model @@ -91,7 +93,7 @@ update key flags next settings msg model = ( m2, c2, s2 ) = update key flags - next + inav settings (DirDropdownMsg (Comp.Dropdown.SetSelection @@ -106,7 +108,7 @@ update key flags next settings msg model = ( m3, c3, s3 ) = update key flags - next + inav settings (OrgDropdownMsg (Comp.Dropdown.SetSelection @@ -121,7 +123,7 @@ update key flags next settings msg model = ( m4, c4, s4 ) = update key flags - next + inav settings (CorrPersonMsg (Comp.Dropdown.SetSelection @@ -136,7 +138,7 @@ update key flags next settings msg model = ( m5, c5, s5 ) = update key flags - next + inav settings (ConcPersonMsg (Comp.Dropdown.SetSelection @@ -151,7 +153,7 @@ update key flags next settings msg model = ( m6, c6, s6 ) = update key flags - next + inav settings (ConcEquipMsg (Comp.Dropdown.SetSelection @@ -164,12 +166,12 @@ update key flags next settings msg model = m5 ( m7, c7, s7 ) = - update key flags next settings AddFilesReset m6 + update key flags inav settings AddFilesReset m6 ( m8, c8, s8 ) = update key flags - next + inav settings (FolderDropdownMsg (Comp.Dropdown.SetSelection @@ -498,7 +500,7 @@ update key flags next settings msg model = noSub ( { model | deleteItemConfirm = cm }, cmd ) RequestDelete -> - update key flags next settings (DeleteItemConfirm Comp.YesNoDimmer.activate) model + update key flags inav settings (DeleteItemConfirm Comp.YesNoDimmer.activate) model SetCorrOrgSuggestion idname -> noSub ( model, setCorrOrg flags model (Just idname) ) @@ -537,7 +539,7 @@ update key flags next settings msg model = |> List.map mkIdName |> Comp.Dropdown.SetOptions in - update key flags next settings (FolderDropdownMsg opts) model_ + update key flags inav settings (FolderDropdownMsg opts) model_ GetFolderResp (Err _) -> noSub ( model, Cmd.none ) @@ -548,7 +550,7 @@ update key flags next settings msg model = Comp.Dropdown.SetOptions tags.items ( m1, c1, s1 ) = - update key flags next settings (TagDropdownMsg tagList) model + update key flags inav settings (TagDropdownMsg tagList) model in ( m1, c1, s1 ) @@ -560,7 +562,7 @@ update key flags next settings msg model = opts = Comp.Dropdown.SetOptions orgs.items in - update key flags next settings (OrgDropdownMsg opts) model + update key flags inav settings (OrgDropdownMsg opts) model GetOrgResp (Err _) -> noSub ( model, Cmd.none ) @@ -571,10 +573,10 @@ update key flags next settings msg model = Comp.Dropdown.SetOptions ps.items ( m1, c1, s1 ) = - update key flags next settings (CorrPersonMsg opts) model + update key flags inav settings (CorrPersonMsg opts) model ( m2, c2, s2 ) = - update key flags next settings (ConcPersonMsg opts) m1 + update key flags inav settings (ConcPersonMsg opts) m1 in ( m2, Cmd.batch [ c1, c2 ], Sub.batch [ s1, s2 ] ) @@ -589,7 +591,7 @@ update key flags next settings msg model = equips.items ) in - update key flags next settings (ConcEquipMsg opts) model + update key flags inav settings (ConcEquipMsg opts) model GetEquipResp (Err _) -> noSub ( model, Cmd.none ) @@ -625,7 +627,7 @@ update key flags next settings msg model = DeleteResp (Ok res) -> if res.success then - case next of + case inav.next of Just id -> noSub ( model, Page.set key (ItemDetailPage id) ) @@ -639,7 +641,7 @@ update key flags next settings msg model = noSub ( model, Cmd.none ) GetItemResp (Ok item) -> - update key flags next settings (SetItem item) model + update key flags inav settings (SetItem item) model GetItemResp (Err _) -> noSub ( model, Cmd.none ) @@ -834,7 +836,7 @@ update key flags next settings msg model = DeleteAttachResp (Ok res) -> if res.success then - update key flags next settings ReloadItem model + update key flags inav settings ReloadItem model else noSub ( model, Cmd.none ) @@ -845,7 +847,7 @@ update key flags next settings msg model = RequestDeleteAttachment id -> update key flags - next + inav settings (DeleteAttachConfirm id Comp.YesNoDimmer.activate) model @@ -1228,6 +1230,41 @@ update key flags next 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 + + else + noSub ( model, Cmd.none ) + + Just Letter_U -> + if model.item.state /= "created" then + update key flags inav settings UnconfirmItem model + + else + noSub ( model, Cmd.none ) + + Just Point -> + case inav.next of + Just id -> + noSub ( model, Page.set key (ItemDetailPage id) ) + + Nothing -> + noSub ( model, Cmd.none ) + + Just Comma -> + case inav.prev of + Just id -> + noSub ( model, Page.set key (ItemDetailPage id) ) + + Nothing -> + noSub ( model, Cmd.none ) + + _ -> + noSub ( model, Cmd.none ) + --- Helper diff --git a/modules/webapp/src/main/elm/Comp/ItemDetail/View.elm b/modules/webapp/src/main/elm/Comp/ItemDetail/View.elm index 216a5832..52c77232 100644 --- a/modules/webapp/src/main/elm/Comp/ItemDetail/View.elm +++ b/modules/webapp/src/main/elm/Comp/ItemDetail/View.elm @@ -14,6 +14,7 @@ import Comp.YesNoDimmer import Data.Direction import Data.Fields import Data.Icons as Icons +import Data.ItemNav exposing (ItemNav) import Data.UiSettings exposing (UiSettings) import DatePicker import Dict @@ -27,6 +28,7 @@ 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 @@ -34,9 +36,11 @@ import Util.String import Util.Time -view : { prev : Maybe String, next : Maybe String } -> UiSettings -> Model -> Html Msg +view : ItemNav -> UiSettings -> Model -> Html Msg view inav settings model = - div [] + div + [ onKeyUpCode KeyPress + ] [ renderItemInfo settings model , renderDetailMenu inav model , renderMailForm settings model @@ -87,7 +91,7 @@ view inav settings model = --- Helper -renderDetailMenu : { prev : Maybe String, next : Maybe String } -> Model -> Html Msg +renderDetailMenu : ItemNav -> Model -> Html Msg renderDetailMenu inav model = div [ classList @@ -109,6 +113,7 @@ renderDetailMenu inav model = , Maybe.map ItemDetailPage inav.prev |> Maybe.map Page.href |> Maybe.withDefault (href "#") + , title "Previous item. Key ','" ] [ i [ class "caret square left outline icon" ] [] ] @@ -120,6 +125,7 @@ renderDetailMenu inav model = , Maybe.map ItemDetailPage inav.next |> Maybe.map Page.href |> Maybe.withDefault (href "#") + , title "Next item. Key '.'" ] [ i [ class "caret square right outline icon" ] [] ] @@ -718,7 +724,7 @@ renderEditButtons model = [ ( "borderless item", True ) , ( "invisible", model.item.state /= "created" ) ] - , title "Confirm metadata" + , title "Confirm metadata. Key 'c'." , href "#" , onClick ConfirmItem ] @@ -730,7 +736,7 @@ renderEditButtons model = , ( "invisible", model.item.state /= "confirmed" ) ] , href "#" - , title "Unconfirm metadata" + , title "Unconfirm metadata. Key 'u'." , onClick UnconfirmItem ] [ i [ class "eye slash outline icon" ] [] diff --git a/modules/webapp/src/main/elm/Data/ItemNav.elm b/modules/webapp/src/main/elm/Data/ItemNav.elm new file mode 100644 index 00000000..6788f6ec --- /dev/null +++ b/modules/webapp/src/main/elm/Data/ItemNav.elm @@ -0,0 +1,7 @@ +module Data.ItemNav exposing (ItemNav) + + +type alias ItemNav = + { prev : Maybe String + , next : Maybe String + } diff --git a/modules/webapp/src/main/elm/Page/Home/Data.elm b/modules/webapp/src/main/elm/Page/Home/Data.elm index c9f2b3e9..fb2ee3c3 100644 --- a/modules/webapp/src/main/elm/Page/Home/Data.elm +++ b/modules/webapp/src/main/elm/Page/Home/Data.elm @@ -18,6 +18,7 @@ import Comp.FixedDropdown import Comp.ItemCardList import Comp.SearchMenu import Data.Flags exposing (Flags) +import Data.ItemNav exposing (ItemNav) import Data.Items import Data.UiSettings exposing (UiSettings) import Http @@ -119,7 +120,7 @@ searchTypeString st = "Contents Only" -itemNav : String -> Model -> { prev : Maybe String, next : Maybe String } +itemNav : String -> Model -> ItemNav itemNav id model = let prev = diff --git a/modules/webapp/src/main/elm/Page/ItemDetail/Update.elm b/modules/webapp/src/main/elm/Page/ItemDetail/Update.elm index f852c33c..001de073 100644 --- a/modules/webapp/src/main/elm/Page/ItemDetail/Update.elm +++ b/modules/webapp/src/main/elm/Page/ItemDetail/Update.elm @@ -5,21 +5,22 @@ import Browser.Navigation as Nav import Comp.ItemDetail import Comp.ItemDetail.Model import Data.Flags exposing (Flags) +import Data.ItemNav exposing (ItemNav) import Data.UiSettings exposing (UiSettings) import Page.ItemDetail.Data exposing (Model, Msg(..)) import Scroll import Task -update : Nav.Key -> Flags -> Maybe String -> UiSettings -> Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) -update key flags next settings msg model = +update : Nav.Key -> Flags -> ItemNav -> UiSettings -> Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) +update key flags inav settings msg model = case msg of Init id -> let ( lm, lc, ls ) = Comp.ItemDetail.update key flags - next + inav settings Comp.ItemDetail.Model.Init model.detail @@ -39,7 +40,7 @@ update key flags next settings msg model = ItemDetailMsg lmsg -> let ( lm, lc, ls ) = - Comp.ItemDetail.update key flags next settings lmsg model.detail + Comp.ItemDetail.update key flags inav settings lmsg model.detail in ( { model | detail = lm } , Cmd.map ItemDetailMsg lc @@ -51,7 +52,7 @@ update key flags next settings msg model = lmsg = Comp.ItemDetail.Model.SetItem item in - update key flags next settings (ItemDetailMsg lmsg) model + update key flags inav settings (ItemDetailMsg lmsg) model ItemResp (Err _) -> ( model, Cmd.none, Sub.none ) diff --git a/modules/webapp/src/main/elm/Page/ItemDetail/View.elm b/modules/webapp/src/main/elm/Page/ItemDetail/View.elm index 5d7efaa4..c00c2b94 100644 --- a/modules/webapp/src/main/elm/Page/ItemDetail/View.elm +++ b/modules/webapp/src/main/elm/Page/ItemDetail/View.elm @@ -1,18 +1,13 @@ module Page.ItemDetail.View exposing (view) import Comp.ItemDetail +import Data.ItemNav exposing (ItemNav) import Data.UiSettings exposing (UiSettings) import Html exposing (..) import Html.Attributes exposing (..) import Page.ItemDetail.Data exposing (Model, Msg(..)) -type alias ItemNav = - { prev : Maybe String - , next : Maybe String - } - - view : ItemNav -> UiSettings -> Model -> Html Msg view inav settings model = div [ class "ui fluid container item-detail-page" ] diff --git a/modules/webapp/src/main/elm/Util/Html.elm b/modules/webapp/src/main/elm/Util/Html.elm index fa56a8f1..38678f09 100644 --- a/modules/webapp/src/main/elm/Util/Html.elm +++ b/modules/webapp/src/main/elm/Util/Html.elm @@ -46,12 +46,16 @@ type KeyCode | Enter | Space | ESC + | Letter_C | Letter_N | Letter_P | Letter_H | Letter_J | Letter_K | Letter_L + | Letter_U + | Point + | Comma | Code Int @@ -79,6 +83,9 @@ intToKeyCode code = 27 -> Just ESC + 67 -> + Just Letter_C + 72 -> Just Letter_H @@ -97,6 +104,15 @@ intToKeyCode code = 80 -> Just Letter_P + 85 -> + Just Letter_U + + 188 -> + Just Comma + + 190 -> + Just Point + n -> Just (Code n) From 5b56ea881ca2c0cd9cfd4a326e57f184b72e6051 Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Tue, 22 Sep 2020 22:07:27 +0200 Subject: [PATCH 4/5] 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)) From 02a0343e55aa2c7c94081beae3c9018de54bad4e Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Tue, 22 Sep 2020 22:33:21 +0200 Subject: [PATCH 5/5] Allow to enable/disable keyboard navigation in user settings --- .../src/main/elm/Comp/ItemDetail/View.elm | 44 ++++++++++++++----- .../src/main/elm/Comp/UiSettingsForm.elm | 25 +++++++++++ .../webapp/src/main/elm/Data/UiSettings.elm | 5 +++ 3 files changed, 63 insertions(+), 11 deletions(-) diff --git a/modules/webapp/src/main/elm/Comp/ItemDetail/View.elm b/modules/webapp/src/main/elm/Comp/ItemDetail/View.elm index 4be58ea3..348f52a4 100644 --- a/modules/webapp/src/main/elm/Comp/ItemDetail/View.elm +++ b/modules/webapp/src/main/elm/Comp/ItemDetail/View.elm @@ -41,7 +41,7 @@ view inav settings model = div [] [ renderItemInfo settings model - , renderDetailMenu inav model + , renderDetailMenu settings inav model , renderMailForm settings model , renderAddFilesForm model , div [ class "ui grid" ] @@ -90,8 +90,16 @@ view inav settings model = --- Helper -renderDetailMenu : ItemNav -> Model -> Html Msg -renderDetailMenu inav model = +renderDetailMenu : UiSettings -> ItemNav -> Model -> Html Msg +renderDetailMenu settings inav model = + let + keyDescr name = + if settings.itemDetailShortcuts && model.menuOpen then + " Key '" ++ name ++ "'." + + else + "" + in div [ classList [ ( "ui ablue-comp menu", True ) @@ -112,7 +120,7 @@ renderDetailMenu inav model = , Maybe.map ItemDetailPage inav.prev |> Maybe.map Page.href |> Maybe.withDefault (href "#") - , title "Previous item. Key 'Ctrl-,'" + , title ("Previous item." ++ keyDescr "Ctrl-,") ] [ i [ class "caret square left outline icon" ] [] ] @@ -124,7 +132,7 @@ renderDetailMenu inav model = , Maybe.map ItemDetailPage inav.next |> Maybe.map Page.href |> Maybe.withDefault (href "#") - , title "Next item. Key 'Ctrl-.'" + , title ("Next item." ++ keyDescr "Ctrl-.") ] [ i [ class "caret square right outline icon" ] [] ] @@ -708,22 +716,36 @@ renderTags settings model = renderEditMenu : UiSettings -> Model -> List (Html Msg) renderEditMenu settings model = [ Html.map ModalEditMsg (Comp.DetailEdit.viewModal settings model.modalEdit) - , div (Comp.KeyInput.eventsM KeyInputMsg) - [ renderEditButtons model + , div + (if settings.itemDetailShortcuts then + Comp.KeyInput.eventsM KeyInputMsg + + else + [] + ) + [ renderEditButtons settings model , renderEditForm settings model ] ] -renderEditButtons : Model -> Html Msg -renderEditButtons model = +renderEditButtons : UiSettings -> Model -> Html Msg +renderEditButtons settings model = + let + keyDescr name = + if settings.itemDetailShortcuts then + " Key '" ++ name ++ "'." + + else + "" + in div [ class "ui top attached icon ablue-comp menu" ] [ a [ classList [ ( "borderless item", True ) , ( "invisible", model.item.state /= "created" ) ] - , title "Confirm metadata. Key 'Ctrl-c'." + , title ("Confirm metadata." ++ keyDescr "Ctrl-c") , href "#" , onClick ConfirmItem ] @@ -735,7 +757,7 @@ renderEditButtons model = , ( "invisible", model.item.state /= "confirmed" ) ] , href "#" - , title "Unconfirm metadata. Key 'Ctrl-c'." + , title ("Unconfirm metadata." ++ keyDescr "Ctrl-c") , onClick UnconfirmItem ] [ i [ class "eye slash outline icon" ] [] diff --git a/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm b/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm index 129c2f1a..7a4a29dc 100644 --- a/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm +++ b/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm @@ -39,6 +39,7 @@ type alias Model = , searchMenuTagCatCount : Maybe Int , searchMenuTagCatCountModel : Comp.IntField.Model , formFields : List Field + , itemDetailShortcuts : Bool } @@ -87,6 +88,7 @@ init flags settings = False "Number of categories in search menu" , formFields = settings.formFields + , itemDetailShortcuts = settings.itemDetailShortcuts } , Api.getTags flags "" GetTagsResp ) @@ -103,6 +105,7 @@ type Msg | SearchMenuTagMsg Comp.IntField.Msg | SearchMenuTagCatMsg Comp.IntField.Msg | FieldListMsg Comp.FieldListSelect.Msg + | ToggleItemDetailShortcuts @@ -261,6 +264,15 @@ update sett msg model = Nothing ) + ToggleItemDetailShortcuts -> + let + flag = + not model.itemDetailShortcuts + in + ( { model | itemDetailShortcuts = flag } + , Just { sett | itemDetailShortcuts = flag } + ) + --- View @@ -342,6 +354,19 @@ view flags _ model = ] ] ] + , div [ class "field" ] + [ div [ class "ui checkbox" ] + [ input + [ type_ "checkbox" + , onCheck (\_ -> ToggleItemDetailShortcuts) + , checked model.itemDetailShortcuts + ] + [] + , label [] + [ text "Use keyboard shortcuts for navigation and confirm/unconfirm with open edit menu." + ] + ] + ] , div [ class "grouped fields" ] [ label [] [ text "Position of item notes" ] , div [ class "field" ] diff --git a/modules/webapp/src/main/elm/Data/UiSettings.elm b/modules/webapp/src/main/elm/Data/UiSettings.elm index 2369b04a..16c978b1 100644 --- a/modules/webapp/src/main/elm/Data/UiSettings.elm +++ b/modules/webapp/src/main/elm/Data/UiSettings.elm @@ -40,6 +40,7 @@ type alias StoredUiSettings = , searchMenuTagCount : Maybe Int , searchMenuTagCatCount : Maybe Int , formFields : Maybe (List String) + , itemDetailShortcuts : Bool } @@ -60,6 +61,7 @@ type alias UiSettings = , searchMenuTagCount : Int , searchMenuTagCatCount : Int , formFields : List Field + , itemDetailShortcuts : Bool } @@ -102,6 +104,7 @@ defaults = , searchMenuTagCount = 6 , searchMenuTagCatCount = 3 , formFields = Data.Fields.all + , itemDetailShortcuts = False } @@ -134,6 +137,7 @@ merge given fallback = choose (Maybe.map Data.Fields.fromList given.formFields) fallback.formFields + , itemDetailShortcuts = given.itemDetailShortcuts } @@ -157,6 +161,7 @@ toStoredUiSettings settings = , formFields = List.map Data.Fields.toString settings.formFields |> Just + , itemDetailShortcuts = settings.itemDetailShortcuts }