Merge pull request #143 from unisonweb/finder-fixes

Finder: arrowkeys, clickable areas, and sequences

Author: hojberg

src/Finder.elm

@@ -513,10 +513,16 @@ view model =
                     , results
                     ]
                 )
+
+        keyboardEvent =
+            KeyboardEvent.on KeyboardEvent.Keydown Keydown
+                |> KeyboardEvent.stopPropagation
+                |> KeyboardEvent.preventDefaultWhen (\evt -> evt.key == ArrowUp || evt.key == ArrowDown)
+                |> KeyboardEvent.attach
     in
     Modal.modal "finder" Close content
         -- We stopPropagation such that movement shortcuts, like J or K, for the
         -- workspace aren't triggered when in the modal when the use is trying to
         -- type those letters into the search field
-        |> Modal.withAttributes [ KeyboardEvent.stopPropagationOn KeyboardEvent.Keydown Keydown ]
+        |> Modal.withAttributes [ keyboardEvent ]
         |> Modal.view

src/KeyboardShortcut.elm

@@ -115,7 +115,7 @@ collect model key =
 
 decay : Key -> Cmd Msg
 decay key =
-    Process.sleep 2000 |> Task.perform (always (Decay key))
+    Process.sleep 3000 |> Task.perform (always (Decay key))
 
 
 

src/KeyboardShortcut/KeyboardEvent.elm

@@ -40,12 +40,16 @@
 module KeyboardShortcut.KeyboardEvent exposing
     ( KeyboardEvent
     , KeyboardEventType(..)
+    , attach
     , decode
     , decodeToMsg
     , isHoldingModifier
     , modifiersHeld
     , on
-    , stopPropagationOn
+    , preventDefault
+    , preventDefaultWhen
+    , stopPropagation
+    , stopPropagationWhen
     , subscribe
     )
 
@@ -116,26 +120,60 @@ modifiersHeld { altKey, ctrlKey, metaKey, shiftKey } =
 -- EVENTS
 
 
-stopPropagationOn : KeyboardEventType -> (KeyboardEvent -> msg) -> Html.Attribute msg
-stopPropagationOn keyboardEventType toMsg =
-    Html.Events.custom (keyboardEventTypeToEventString keyboardEventType)
-        (decodeToMsg toMsg
-            |> Decode.andThen
-                (\msg ->
-                    Decode.succeed
-                        { message = msg
-                        , stopPropagation = True
-                        , preventDefault = False
-                        }
-                )
-        )
-
-
-on : KeyboardEventType -> (KeyboardEvent -> msg) -> Html.Attribute msg
-on eventType toMsg =
-    Html.Events.on
-        (keyboardEventTypeToEventString eventType)
-        (Decode.map toMsg decode)
+type alias KeyboardListener msg =
+    { keyboardEventType : KeyboardEventType
+    , toMsg : KeyboardEvent -> msg
+    , stopPropagation : KeyboardEvent -> Bool
+    , preventDefault : KeyboardEvent -> Bool
+    }
+
+
+on : KeyboardEventType -> (KeyboardEvent -> msg) -> KeyboardListener msg
+on keyboardEventType toMsg =
+    { keyboardEventType = keyboardEventType
+    , toMsg = toMsg
+    , stopPropagation = always False
+    , preventDefault = always False
+    }
+
+
+stopPropagation : KeyboardListener msg -> KeyboardListener msg
+stopPropagation listener =
+    { listener | stopPropagation = always True }
+
+
+stopPropagationWhen : (KeyboardEvent -> Bool) -> KeyboardListener msg -> KeyboardListener msg
+stopPropagationWhen when listener =
+    { listener | stopPropagation = when }
+
+
+preventDefault : KeyboardListener msg -> KeyboardListener msg
+preventDefault listener =
+    { listener | preventDefault = always True }
+
+
+preventDefaultWhen : (KeyboardEvent -> Bool) -> KeyboardListener msg -> KeyboardListener msg
+preventDefaultWhen when listener =
+    { listener | preventDefault = when }
+
+
+attach : KeyboardListener msg -> Html.Attribute msg
+attach listener =
+    let
+        toEventConfig event =
+            { message = listener.toMsg event
+            , stopPropagation = listener.stopPropagation event
+            , preventDefault = listener.preventDefault event
+            }
+    in
+    Html.Events.custom (keyboardEventTypeToEventString listener.keyboardEventType)
+        (Decode.map toEventConfig decode)
+
+
+
+{--| Note that there's a limitation to Browser.Event in that it does not support
+stopPropagation and preventDefault: https://github.com/elm/browser/issues/77,
+https://github.com/elm/browser/issues/89 --}
 
 
 subscribe : KeyboardEventType -> (KeyboardEvent -> msg) -> Sub msg

src/css/main.css

@@ -1731,6 +1731,7 @@ button.danger:hover {
   text-overflow: ellipsis;
   max-width: 14rem;
   overflow: hidden;
+  cursor: pointer;
 }
 
 #finder .definition-match .namespace {
@@ -1739,6 +1740,7 @@ button.danger:hover {
   text-overflow: ellipsis;
   max-width: 14rem;
   overflow: hidden;
+  cursor: pointer;
 }
 
 #finder .definition-match .namespace .in {