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/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 ] [] 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/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..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 @@ -85,6 +86,7 @@ type alias Model = , attachDD : DD.Model String String , modalEdit : Maybe Comp.DetailEdit.Model , attachRename : Maybe AttachmentRename + , keyInputModel : Comp.KeyInput.Model } @@ -184,6 +186,7 @@ emptyModel = , attachDD = DD.init , modalEdit = Nothing , attachRename = Nothing + , keyInputModel = Comp.KeyInput.init } @@ -265,6 +268,7 @@ type Msg | ResetHiddenMsg Field (Result Http.Error BasicResult) | SaveNameResp (Result Http.Error BasicResult) | UpdateThrottle + | 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 d768b0e2..395f15f1 100644 --- a/modules/webapp/src/main/elm/Comp/ItemDetail/Update.elm +++ b/modules/webapp/src/main/elm/Comp/ItemDetail/Update.elm @@ -28,14 +28,16 @@ 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) import Data.UiSettings exposing (UiSettings) import DatePicker import Dict @@ -56,8 +58,8 @@ 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,42 @@ update key flags next settings msg model = in withSub ( { model | nameSaveThrottle = newThrottle }, cmd ) + KeyInputMsg lm -> + let + ( km, keys ) = + Comp.KeyInput.update lm model.keyInputModel + + 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_ + + else + update key flags inav settings UnconfirmItem model_ + + else if keys == Just Comp.KeyInput.ctrlPoint then + case inav.next of + Just id -> + noSub ( model_, Page.set key (ItemDetailPage id) ) + + 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) ) + + Nothing -> + 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 ) + --- 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..348f52a4 100644 --- a/modules/webapp/src/main/elm/Comp/ItemDetail/View.elm +++ b/modules/webapp/src/main/elm/Comp/ItemDetail/View.elm @@ -8,12 +8,14 @@ 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 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 @@ -34,11 +36,12 @@ 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 + [] [ renderItemInfo settings model - , renderDetailMenu inav model + , renderDetailMenu settings inav model , renderMailForm settings model , renderAddFilesForm model , div [ class "ui grid" ] @@ -87,8 +90,16 @@ view inav settings model = --- Helper -renderDetailMenu : { prev : Maybe String, next : Maybe String } -> 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 ) @@ -109,6 +120,7 @@ renderDetailMenu inav model = , Maybe.map ItemDetailPage inav.prev |> Maybe.map Page.href |> Maybe.withDefault (href "#") + , title ("Previous item." ++ keyDescr "Ctrl-,") ] [ i [ class "caret square left outline icon" ] [] ] @@ -120,6 +132,7 @@ renderDetailMenu inav model = , Maybe.map ItemDetailPage inav.next |> Maybe.map Page.href |> Maybe.withDefault (href "#") + , title ("Next item." ++ keyDescr "Ctrl-.") ] [ i [ class "caret square right outline icon" ] [] ] @@ -703,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 [] - [ 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" + , title ("Confirm metadata." ++ keyDescr "Ctrl-c") , href "#" , onClick ConfirmItem ] @@ -730,7 +757,7 @@ renderEditButtons model = , ( "invisible", model.item.state /= "confirmed" ) ] , href "#" - , title "Unconfirm metadata" + , title ("Unconfirm metadata." ++ keyDescr "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/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/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/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 } 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 7649fa46..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 ) @@ -45,11 +47,35 @@ type KeyCode | Right | Enter | Space + | ESC + | Letter_C + | Letter_N + | Letter_P + | Letter_H + | Letter_J + | Letter_K + | Letter_L + | 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 @@ -68,8 +94,41 @@ intToKeyCode code = 32 -> Just Space - _ -> - Nothing + 27 -> + Just ESC + + 67 -> + Just Letter_C + + 72 -> + Just Letter_H + + 74 -> + Just Letter_J + + 75 -> + Just Letter_K + + 76 -> + Just Letter_L + + 78 -> + Just Letter_N + + 80 -> + Just Letter_P + + 85 -> + Just Letter_U + + 188 -> + Just Comma + + 190 -> + Just Point + + n -> + Just (Code n) onKeyUp : (Int -> msg) -> Attribute msg @@ -77,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))