Garmelon/forest
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[tui] Clean up and add more key bindings

Browse source
This commit is contained in:
Joscha 2020-03-20 00:25:39 +00:00
parent c2b4a23542
commit 53b4b2c9a0
2 changed files with 55 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

64
forest-tui/src/Forest/Client.hs
View file

@ -55,33 +55,39 @@ onUiState' cs f = do
{- ... without active editor -} {- ... without active editor -}
deleteNode :: ClientState -> ClientM ()
deleteNode cs =
when (flagDelete $ nodeFlags $ focusedNode s) $
liftIO $ sendPacket (csConn cs) $ ClientDelete (focusedPath s)
where
s = csUiState cs
actUponNode :: ClientState -> ClientM ()
actUponNode cs =
when (flagAct $ nodeFlags $ focusedNode s) $
liftIO $ sendPacket (csConn cs) $ ClientAct (focusedPath s)
where
s = csUiState cs
onKeyWithoutEditor :: ClientState -> Vty.Event -> ClientM (Next ClientState) onKeyWithoutEditor :: ClientState -> Vty.Event -> ClientM (Next ClientState)
onKeyWithoutEditor cs (Vty.EvKey k _) onKeyWithoutEditor cs (Vty.EvKey k _)
| k `elem` quitKeys = halt cs | k `elem` [Vty.KChar 'q', Vty.KEsc] = halt cs
| k `elem` foldKeys = onUiState cs toggleFoldAtFocus | k == Vty.KChar '\t' = onUiState cs toggleFoldAtFocus
| k `elem` upKeys = onUiState cs moveFocusUp | k `elem` [Vty.KChar 'k', Vty.KUp] = onUiState cs moveFocusUp
| k `elem` downKeys = onUiState cs moveFocusDown | k `elem` [Vty.KChar 'j', Vty.KDown] = onUiState cs moveFocusDown
| k `elem` editKeys = onUiState cs editCurrentNode | k `elem` [Vty.KChar 'K', Vty.KPageUp] = onUiState cs moveFocusToPrevSibling
| k `elem` deleteKeys = do | k `elem` [Vty.KChar 'J', Vty.KPageDown] =
when (flagDelete $ nodeFlags $ focusedNode $ csUiState cs) $ onUiState cs moveFocusToNextSibling
liftIO $ sendPacket (csConn cs) $ ClientDelete (focusedPath $ csUiState cs) | k `elem` [Vty.KChar 'h', Vty.KLeft] = onUiState cs moveFocusToParent
continue cs | k `elem` [Vty.KChar 'g', Vty.KHome] = onUiState cs moveFocusToTop
| k `elem` replyKeys = onUiState cs (replyToCurrentNode . unfoldAtFocus) | k `elem` [Vty.KChar 'G', Vty.KEnd] = onUiState cs moveFocusToBottom
| k `elem` replyKeys' = onUiState cs replyAfterCurrentNode | k == Vty.KChar 'e' = onUiState cs editCurrentNode
| k `elem` actKeys = do | k == Vty.KChar 'r' = onUiState cs (replyToCurrentNode . unfoldAtFocus)
when (flagAct $ nodeFlags $ focusedNode $ csUiState cs) $ | k == Vty.KChar 'R' = onUiState cs replyAfterCurrentNode
liftIO $ sendPacket (csConn cs) $ ClientAct (focusedPath $ csUiState cs) | k `elem` [Vty.KChar 'd', Vty.KChar 'x', Vty.KDel, Vty.KBS] =
continue cs deleteNode cs *> continue cs
where | k `elem` [Vty.KChar 'a', Vty.KChar ' ', Vty.KEnter] =
quitKeys = [Vty.KChar 'q', Vty.KEsc] actUponNode cs *> continue cs
foldKeys = [Vty.KChar '\t']
upKeys = [Vty.KChar 'k', Vty.KUp]
downKeys = [Vty.KChar 'j', Vty.KDown]
editKeys = [Vty.KChar 'e']
deleteKeys = [Vty.KChar 'd']
replyKeys = [Vty.KChar 'r']
replyKeys' = [Vty.KChar 'R']
actKeys = [Vty.KChar 'a', Vty.KChar ' ', Vty.KEnter]
onKeyWithoutEditor cs _ = continue cs onKeyWithoutEditor cs _ = continue cs
{- ... with active editor -} {- ... with active editor -}
@ -134,11 +140,11 @@ clientAttrMap = attrMap Vty.defAttr
clientApp :: App ClientState Event ResourceName clientApp :: App ClientState Event ResourceName
clientApp = App clientApp = App
{ appDraw = clientDraw { appDraw = clientDraw
, appChooseCursor = showFirstCursor , appChooseCursor = showFirstCursor
, appHandleEvent = clientHandleEvent , appHandleEvent = clientHandleEvent
, appStartEvent = pure , appStartEvent = pure
, appAttrMap = const clientAttrMap , appAttrMap = const clientAttrMap
} }
runClient :: WS.Connection -> BChan Event -> Node -> IO () runClient :: WS.Connection -> BChan Event -> Node -> IO ()

20
forest-tui/src/Forest/Client/UiState.hs
View file

@ -9,6 +9,11 @@ module Forest.Client.UiState
, replaceRootNode , replaceRootNode
, moveFocusUp , moveFocusUp
, moveFocusDown , moveFocusDown
, moveFocusToParent
, moveFocusToPrevSibling
, moveFocusToNextSibling
, moveFocusToTop
, moveFocusToBottom
, foldAtFocus , foldAtFocus
, unfoldAtFocus , unfoldAtFocus
, toggleFoldAtFocus , toggleFoldAtFocus
@ -146,6 +151,21 @@ moveFocusUp = moveFocus prevNode
moveFocusDown :: UiState n -> UiState n moveFocusDown :: UiState n -> UiState n
moveFocusDown = moveFocus nextNode moveFocusDown = moveFocus nextNode
moveFocusToPrevSibling :: UiState n -> UiState n
moveFocusToPrevSibling = moveFocus prevSibling
moveFocusToNextSibling :: UiState n -> UiState n
moveFocusToNextSibling = moveFocus nextSibling
moveFocusToParent :: UiState n -> UiState n
moveFocusToParent = moveFocus $ const parent
moveFocusToTop :: UiState n -> UiState n
moveFocusToTop = moveFocus firstNode
moveFocusToBottom :: UiState n -> UiState n
moveFocusToBottom = moveFocus lastNode
foldAtFocus :: UiState n -> UiState n foldAtFocus :: UiState n -> UiState n
foldAtFocus s = foldAtFocus s =
validateUnfolded s{uiUnfolded = Set.delete (uiFocused s) (uiUnfolded s)} validateUnfolded s{uiUnfolded = Set.delete (uiFocused s) (uiUnfolded s)}