slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ui: accounts: left click enters register

Browse Source
This commit is contained in:
Simon Michael 2021-11-17 17:42:34 -10:00
parent 2076d5a98b
commit 35402fb472
1 changed files with 24 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
hledger-ui/Hledger/UI/AccountsScreen.hs
View File

@ -12,7 +12,7 @@ where
import Brick import Brick
import Brick.Widgets.List import Brick.Widgets.List
(handleListEvent, list, listElementsL, listMoveDown, listMoveTo, listNameL, listSelectedElement, listSelectedL, renderList) (handleListEvent, list, listElementsL, listMoveDown, listMoveTo, listNameL, listSelectedElement, listSelectedL, renderList, listElements)
import Brick.Widgets.Edit import Brick.Widgets.Edit
import Control.Monad import Control.Monad
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
@ -21,7 +21,7 @@ import Data.Maybe
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day)
import qualified Data.Vector as V import qualified Data.Vector as V
import Graphics.Vty (Event(..),Key(..),Modifier(..)) import Graphics.Vty (Event(..),Key(..),Modifier(..), Button (BLeft))
import Lens.Micro.Platform import Lens.Micro.Platform
import Safe import Safe
import System.Console.ANSI import System.Console.ANSI
@ -37,6 +37,7 @@ import Hledger.UI.UIUtils
import Hledger.UI.Editor import Hledger.UI.Editor
import Hledger.UI.RegisterScreen import Hledger.UI.RegisterScreen
import Hledger.UI.ErrorScreen import Hledger.UI.ErrorScreen
import Data.Vector ((!?))
accountsScreen :: Screen accountsScreen :: Screen
@ -319,16 +320,13 @@ asHandle ui0@UIState{
-- enter register screen for selected account (if there is one), -- enter register screen for selected account (if there is one),
-- centering its selected transaction if possible -- centering its selected transaction if possible
VtyEvent e | e `elem` moveRightEvents VtyEvent e | e `elem` moveRightEvents
, not $ isBlankElement $ listSelectedElement _asList-> , not $ isBlankElement $ listSelectedElement _asList -> asEnterRegister d selacct ui
-- TODO center selection after entering register screen; neither of these works till second time entering; easy strictifications didn't help
rsCenterAndContinue $ MouseDown _n BLeft _mods Location{loc=(_x,y)} | not $ (=="") clickedacct -> do
-- flip rsHandle (VtyEvent (EvKey (KChar 'l') [MCtrl])) $ let list' = listMoveTo y _asList
screenEnter d regscr ui asEnterRegister d clickedacct ui{aScreen=scr{_asList=list'}}
where where
regscr = rsSetAccount selacct isdepthclipped registerScreen clickedacct = maybe "" asItemAccountName $ listElements _asList !? y
isdepthclipped = case getDepth ui of
Just d -> accountNameLevel selacct >= d
Nothing -> False
-- prevent moving down over blank padding items; -- prevent moving down over blank padding items;
-- instead scroll down by one, until maximally scrolled - shows the end has been reached -- instead scroll down by one, until maximally scrolled - shows the end has been reached
@ -356,15 +354,26 @@ asHandle ui0@UIState{
& asSelectedAccount .~ selacct & asSelectedAccount .~ selacct
} }
AppEvent _ -> continue ui
MouseDown{} -> continue ui MouseDown{} -> continue ui
MouseUp{} -> continue ui MouseUp{} -> continue ui
AppEvent _ -> continue ui
where where
journalspan = journalDateSpan False j journalspan = journalDateSpan False j
asHandle _ _ = error "event handler called with wrong screen type, should not happen" -- PARTIAL: asHandle _ _ = error "event handler called with wrong screen type, should not happen" -- PARTIAL:
asEnterRegister d selacct ui = do
-- TODO center selection after entering register screen; neither of these works till second time entering; easy strictifications didn't help
rsCenterAndContinue $
-- flip rsHandle (VtyEvent (EvKey (KChar 'l') [MCtrl])) $
screenEnter d regscr ui
where
regscr = rsSetAccount selacct isdepthclipped registerScreen
isdepthclipped = case getDepth ui of
Just d -> accountNameLevel selacct >= d
Nothing -> False
asSetSelectedAccount a s@AccountsScreen{} = s & asSelectedAccount .~ a asSetSelectedAccount a s@AccountsScreen{} = s & asSelectedAccount .~ a
asSetSelectedAccount _ s = s asSetSelectedAccount _ s = s