TheAnachronism/docspell
1
0
Fork 0
mirror of https://github.com/TheAnachronism/docspell.git synced 2025-06-21 01:48:26 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #279 from eikek/keyboard-support

Browse Source 
Keyboard support
This commit is contained in:
mergify[bot]
2020-09-22 21:45:24 +00:00
committed by GitHub
parent cbc8350b60 02a0343e55
commit 10c16bf319
15 changed files with 497 additions and 61 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
modules/webapp/src/main/elm/App/Update.elm
View File

@ -195,7 +195,7 @@ updateItemDetail lmsg model =
Page.ItemDetail.Update.update
model.key
model.flags
inav.next
inav
model.uiSettings
lmsg
model.itemDetailModel

57
modules/webapp/src/main/elm/Comp/Dropdown.elm
View File

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

112
modules/webapp/src/main/elm/Comp/FixedDropdown.elm
View File

@ -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
]

5
modules/webapp/src/main/elm/Comp/ItemDetail.elm
View File

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

4
modules/webapp/src/main/elm/Comp/ItemDetail/Model.elm
View File

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

82
modules/webapp/src/main/elm/Comp/ItemDetail/Update.elm
View File

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

49
modules/webapp/src/main/elm/Comp/ItemDetail/View.elm
View File

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

116
modules/webapp/src/main/elm/Comp/KeyInput.elm Normal file
View File

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

25
modules/webapp/src/main/elm/Comp/UiSettingsForm.elm
View File

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

7
modules/webapp/src/main/elm/Data/ItemNav.elm Normal file
View File

@ -0,0 +1,7 @@
module Data.ItemNav exposing (ItemNav)
type alias ItemNav =
{ prev : Maybe String
, next : Maybe String
}

5
modules/webapp/src/main/elm/Data/UiSettings.elm
View File

@ -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
}

3
modules/webapp/src/main/elm/Page/Home/Data.elm
View File

@ -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 =

11
modules/webapp/src/main/elm/Page/ItemDetail/Update.elm
View File

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

7
modules/webapp/src/main/elm/Page/ItemDetail/View.elm
View File

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

73
modules/webapp/src/main/elm/Util/Html.elm
View File

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