Use Ctrl modifier when navigating in item detail

Otherwise it clashes with input fields

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

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 ->
+        KeyInputMsg lm ->
-            case n of
+            let
-                Just Letter_C ->
+                ( km, keys ) =
-                    if model.item.state == "created" then
+                    Comp.KeyInput.update lm model.keyInputModel
-                        update key flags inav settings ConfirmItem model
 
-                    else
+                model_ =
-                        noSub ( model, Cmd.none )
+                    { 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 ->
+                else
-                    if model.item.state /= "created" then
+                    update key flags inav settings UnconfirmItem model_
-                        update key flags inav settings UnconfirmItem model
 
-                    else
+            else if keys == Just Comp.KeyInput.ctrlPoint then
-                        noSub ( model, Cmd.none )
+                case inav.next of
+                    Just id ->
+                        noSub ( model_, Page.set key (ItemDetailPage id) )
 
-                Just Point ->
+                    Nothing ->
-                    case inav.next of
+                        noSub ( model_, Cmd.none )
-                        Just id ->
-                            noSub ( model, Page.set key (ItemDetailPage id) )
 
-                        Nothing ->
+            else if keys == Just Comp.KeyInput.ctrlComma then
-                            noSub ( model, Cmd.none )
+                case inav.prev of
+                    Just id ->
+                        noSub ( model_, Page.set key (ItemDetailPage id) )
 
-                Just Comma ->
+                    Nothing ->
-                    case inav.prev of
+                        noSub ( model_, Cmd.none )
-                        Just id ->
-                            noSub ( model, Page.set key (ItemDetailPage id) )
 
-                        Nothing ->
+            else
-                            noSub ( model, Cmd.none )
+                -- withSub because the keypress may be inside the name
-
+                -- field and requires to activate the throttle
-                _ ->
+                withSub ( model_, Cmd.none )
-                    noSub ( model, Cmd.none )
 
 
 

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" ] []

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

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