From ef5e152fdefa0dac06a8519850ac1bb55e57f24f Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 30 Jun 2017 15:51:08 +0100 Subject: [PATCH] ui: better scrolling/positioning In the accounts and register screens:, you can now scroll down further so that the last item need not always be shown at the bottom of the screen. Also we now try to center the selected item in the following situations: - after moving to the end with Page down/End - after toggling filters (status, real, historical..) - on pressing the control-l key (should force a screen redraw, also) - on entering the register screen from the accounts screen (there's a known problem with this: it doesn't work the first time). Items near the top of the list can't be centered, as we don't scroll higher than the top of the list. --- hledger-ui/Hledger/UI/AccountsScreen.hs | 78 +++++++++++++++++------- hledger-ui/Hledger/UI/RegisterScreen.hs | 80 +++++++++++++++++++------ hledger-ui/Hledger/UI/UIUtils.hs | 32 +++++++++- 3 files changed, 149 insertions(+), 41 deletions(-) diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index 8e7f19198..757841de1 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -54,7 +54,7 @@ asInit d reset ui@UIState{ } = ui{aopts=uopts', aScreen=s & asList .~ newitems'} where - newitems = list AccountsList (V.fromList displayitems) 1 + newitems = list AccountsList (V.fromList $ displayitems ++ blankitems) 1 -- keep the selection near the last selected account -- (may need to move to the next leaf account when entering flat mode) @@ -98,6 +98,13 @@ asInit d reset ui@UIState{ Mixed amts = normaliseMixedAmountSquashPricesForDisplay $ stripPrices bal stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=NoPrice} displayitems = map displayitem items + -- blanks added for scrolling control, cf RegisterScreen + blankitems = replicate 100 + AccountsScreenItem{asItemIndentLevel = 0 + ,asItemAccountName = "" + ,asItemDisplayAccountName = "" + ,asItemRenderedAmounts = [] + } asInit _ _ _ = error "init function called with wrong screen type, should not happen" @@ -191,7 +198,8 @@ asDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} cur = str (case _asList s ^. listSelectedL of Nothing -> "-" Just i -> show (i + 1)) - total = str $ show $ V.length $ s ^. asList . listElementsL + total = str $ show $ V.length nonblanks + nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ s ^. asList . listElementsL bottomlabel = case mode of Minibuffer ed -> minibuffer ed @@ -255,9 +263,9 @@ asHandle ui0@UIState{ ,aMode=mode } ev = do d <- liftIO getCurrentDay - -- c <- getContext - -- let h = c^.availHeightL - -- moveSel n l = listMoveBy n l + let + nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ _asList^.listElementsL + lastnonblankidx = max 0 (length nonblanks - 1) -- save the currently selected account, in case we leave this screen and lose the selection let @@ -315,13 +323,13 @@ asHandle ui0@UIState{ VtyEvent (EvKey (KChar '_') []) -> continue $ regenerateScreens j d $ decDepth ui VtyEvent (EvKey (KChar c) []) | c `elem` ['+','='] -> continue $ regenerateScreens j d $ incDepth ui VtyEvent (EvKey (KChar 't') []) -> continue $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui - VtyEvent (EvKey (KChar 'H') []) -> continue $ regenerateScreens j d $ toggleHistorical ui - VtyEvent (EvKey (KChar 'F') []) -> continue $ regenerateScreens j d $ toggleFlat ui - VtyEvent (EvKey (KChar 'Z') []) -> scrollTop >> (continue $ regenerateScreens j d $ toggleEmpty ui) - VtyEvent (EvKey (KChar 'U') []) -> scrollTop >> (continue $ regenerateScreens j d $ toggleUnmarked ui) - VtyEvent (EvKey (KChar 'P') []) -> scrollTop >> (continue $ regenerateScreens j d $ togglePending ui) - VtyEvent (EvKey (KChar 'C') []) -> scrollTop >> (continue $ regenerateScreens j d $ toggleCleared ui) - VtyEvent (EvKey (KChar 'R') []) -> scrollTop >> (continue $ regenerateScreens j d $ toggleReal ui) + VtyEvent (EvKey (KChar 'H') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleHistorical ui + VtyEvent (EvKey (KChar 'F') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleFlat ui + VtyEvent (EvKey (KChar 'Z') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleEmpty ui + VtyEvent (EvKey (KChar 'U') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleUnmarked ui + VtyEvent (EvKey (KChar 'P') []) -> asCenterAndContinue $ regenerateScreens j d $ togglePending ui + VtyEvent (EvKey (KChar 'C') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleCleared ui + VtyEvent (EvKey (KChar 'R') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleReal ui VtyEvent (EvKey (KDown) [MShift]) -> continue $ regenerateScreens j d $ shrinkReportPeriod d ui VtyEvent (EvKey (KUp) [MShift]) -> continue $ regenerateScreens j d $ growReportPeriod d ui VtyEvent (EvKey (KRight) [MShift]) -> continue $ regenerateScreens j d $ nextReportPeriod journalspan ui @@ -329,13 +337,42 @@ asHandle ui0@UIState{ VtyEvent (EvKey (KChar '/') []) -> continue $ regenerateScreens j d $ showMinibuffer ui VtyEvent (EvKey k []) | k `elem` [KBS, KDel] -> (continue $ regenerateScreens j d $ resetFilter ui) VtyEvent (EvKey k []) | k `elem` [KLeft, KChar 'h'] -> continue $ popScreen ui - VtyEvent (EvKey k []) | k `elem` [KRight, KChar 'l'] -> scrollTopRegister >> continue (screenEnter d scr ui) + VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle _asList >> invalidateCache >> continue ui + + -- enter register screen for selected account (if there is one), + -- centering its selected transaction if possible + VtyEvent (EvKey k []) + | k `elem` [KRight, KChar 'l'] + , not $ isBlankElement $ listSelectedElement _asList-> + -- 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 - scr = rsSetAccount selacct isdepthclipped registerScreen + regscr = rsSetAccount selacct isdepthclipped registerScreen isdepthclipped = case getDepth ui of Just d -> accountNameLevel selacct >= d Nothing -> False + -- prevent moving down over blank padding items; + -- instead scroll down by one, until maximally scrolled - shows the end has been reached + VtyEvent (EvKey (KDown) []) | isBlankElement mnextelement -> do + vScrollBy (viewportScroll $ _asList^.listNameL) 1 + continue ui + where + mnextelement = listSelectedElement $ listMoveDown _asList + + -- if page down or end leads to a blank padding item, stop at last non-blank + VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do + list <- handleListEvent e _asList + if isBlankElement $ listSelectedElement list + then do + let list' = listMoveTo lastnonblankidx list + scrollSelectionToMiddle list' + continue ui{aScreen=scr{_asList=list'}} + else + continue ui{aScreen=scr{_asList=list}} + -- fall through to the list's event handler (handles up/down) VtyEvent ev -> do @@ -348,18 +385,12 @@ asHandle ui0@UIState{ & asSelectedAccount .~ selacct } -- continue =<< handleEventLensed ui someLens ev + AppEvent _ -> continue ui MouseDown _ _ _ _ -> continue ui MouseUp _ _ _ -> continue ui where - -- Encourage a more stable scroll position when toggling list items. - -- We scroll to the top, and the viewport will automatically - -- scroll down just far enough to reveal the selection, which - -- usually leaves it at bottom of screen). - -- XXX better: scroll so selection is in middle of screen ? - scrollTop = vScrollToBeginning $ viewportScroll AccountsViewport - scrollTopRegister = vScrollToBeginning $ viewportScroll RegisterViewport journalspan = journalDateSpan False j asHandle _ _ = error "event handler called with wrong screen type, should not happen" @@ -367,3 +398,8 @@ asHandle _ _ = error "event handler called with wrong screen type, should not ha asSetSelectedAccount a s@AccountsScreen{} = s & asSelectedAccount .~ a asSetSelectedAccount _ s = s +isBlankElement mel = ((asItemAccountName . snd) <$> mel) == Just "" + +asCenterAndContinue ui = do + scrollSelectionToMiddle $ _asList $ aScreen ui + continue ui diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 52c06cd68..ab4ad9476 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -4,11 +4,12 @@ module Hledger.UI.RegisterScreen (registerScreen + ,rsHandle ,rsSetAccount + ,rsCenterAndContinue ) where -import Lens.Micro.Platform ((^.)) import Control.Monad import Control.Monad.IO.Class (liftIO) import Data.List @@ -23,6 +24,7 @@ import Brick import Brick.Widgets.List import Brick.Widgets.Edit import Brick.Widgets.Border (borderAttr) +import Lens.Micro.Platform import System.Console.ANSI @@ -86,9 +88,18 @@ rsInit d reset ui@UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}, ajo ,rsItemBalanceAmount = showMixedAmountOneLineWithoutPrice bal ,rsItemTransaction = t } - + -- blank items are added to allow more control of scroll position; we won't allow movement over these + blankitems = replicate 100 -- 100 ought to be enough for anyone + RegisterScreenItem{rsItemDate = "" + ,rsItemStatus = Unmarked + ,rsItemDescription = "" + ,rsItemOtherAccounts = "" + ,rsItemChangeAmount = "" + ,rsItemBalanceAmount = "" + ,rsItemTransaction = nulltransaction + } -- build the List - newitems = list RegisterList (V.fromList displayitems) 1 + newitems = list RegisterList (V.fromList $ displayitems ++ blankitems) 1 -- keep the selection on the previously selected transaction if possible, -- (eg after toggling nonzero mode), otherwise select the last element. @@ -99,7 +110,7 @@ rsInit d reset ui@UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}, ajo (_, Nothing) -> endidx (_, Just (_,RegisterScreenItem{rsItemTransaction=Transaction{tindex=ti}})) -> fromMaybe endidx $ findIndex ((==ti) . tindex . rsItemTransaction) displayitems - endidx = length displayitems + endidx = length displayitems - 1 rsInit _ _ _ = error "init function called with wrong screen type, should not happen" @@ -188,7 +199,8 @@ rsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} cur = str $ case rsList ^. listSelectedL of Nothing -> "-" Just i -> show (i + 1) - total = str $ show $ length displayitems + total = str $ show $ length nonblanks + nonblanks = V.takeWhile (not . null . rsItemDate) $ rsList^.listElementsL -- query = query_ $ reportopts_ $ cliopts_ opts @@ -247,7 +259,11 @@ rsHandle ui@UIState{ ,aMode=mode } ev = do d <- liftIO getCurrentDay - + let + journalspan = journalDateSpan False j + nonblanks = V.takeWhile (not . null . rsItemDate) $ rsList^.listElementsL + lastnonblankidx = max 0 (length nonblanks - 1) + case mode of Minibuffer ed -> case ev of @@ -288,20 +304,23 @@ rsHandle ui@UIState{ rsItemTransaction=Transaction{tsourcepos=GenericSourcePos f l c}}) -> (Just (l, Just c),f) Just (_, RegisterScreenItem{ rsItemTransaction=Transaction{tsourcepos=JournalSourcePos f (l,_)}}) -> (Just (l, Nothing),f) - VtyEvent (EvKey (KChar 'H') []) -> continue $ regenerateScreens j d $ toggleHistorical ui - VtyEvent (EvKey (KChar 'F') []) -> scrollTop >> (continue $ regenerateScreens j d $ toggleFlat ui) - VtyEvent (EvKey (KChar 'Z') []) -> scrollTop >> (continue $ regenerateScreens j d $ toggleEmpty ui) - VtyEvent (EvKey (KChar 'U') []) -> scrollTop >> (continue $ regenerateScreens j d $ toggleUnmarked ui) - VtyEvent (EvKey (KChar 'P') []) -> scrollTop >> (continue $ regenerateScreens j d $ togglePending ui) - VtyEvent (EvKey (KChar 'C') []) -> scrollTop >> (continue $ regenerateScreens j d $ toggleCleared ui) - VtyEvent (EvKey (KChar 'R') []) -> scrollTop >> (continue $ regenerateScreens j d $ toggleReal ui) - VtyEvent (EvKey (KChar '/') []) -> (continue $ regenerateScreens j d $ showMinibuffer ui) + VtyEvent (EvKey (KChar 'H') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleHistorical ui + VtyEvent (EvKey (KChar 'F') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleFlat ui + VtyEvent (EvKey (KChar 'Z') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleEmpty ui + VtyEvent (EvKey (KChar 'U') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleUnmarked ui + VtyEvent (EvKey (KChar 'P') []) -> rsCenterAndContinue $ regenerateScreens j d $ togglePending ui + VtyEvent (EvKey (KChar 'C') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleCleared ui + VtyEvent (EvKey (KChar 'R') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleReal ui + VtyEvent (EvKey (KChar '/') []) -> continue $ regenerateScreens j d $ showMinibuffer ui VtyEvent (EvKey (KDown) [MShift]) -> continue $ regenerateScreens j d $ shrinkReportPeriod d ui VtyEvent (EvKey (KUp) [MShift]) -> continue $ regenerateScreens j d $ growReportPeriod d ui VtyEvent (EvKey (KRight) [MShift]) -> continue $ regenerateScreens j d $ nextReportPeriod journalspan ui VtyEvent (EvKey (KLeft) [MShift]) -> continue $ regenerateScreens j d $ previousReportPeriod journalspan ui VtyEvent (EvKey k []) | k `elem` [KBS, KDel] -> (continue $ regenerateScreens j d $ resetFilter ui) VtyEvent (EvKey k []) | k `elem` [KLeft, KChar 'h'] -> continue $ popScreen ui + VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle rsList >> invalidateCache >> continue ui + + -- enter transaction screen for selected transaction VtyEvent (EvKey k []) | k `elem` [KRight, KChar 'l'] -> do case listSelectedElement rsList of Just (_, RegisterScreenItem{rsItemTransaction=t}) -> @@ -314,7 +333,27 @@ rsHandle ui@UIState{ ,tsTransactions=numberedts ,tsAccount=rsAccount} ui Nothing -> continue ui - -- fall through to the list's event handler (handles [pg]up/down) + + -- prevent moving down over blank padding items; + -- instead scroll down by one, until maximally scrolled - shows the end has been reached + VtyEvent (EvKey (KDown) []) | isBlankElement mnextelement -> do + vScrollBy (viewportScroll $ rsList^.listNameL) 1 + continue ui + where + mnextelement = listSelectedElement $ listMoveDown rsList + + -- if page down or end leads to a blank padding item, stop at last non-blank + VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do + list <- handleListEvent e rsList + if isBlankElement $ listSelectedElement list + then do + let list' = listMoveTo lastnonblankidx list + scrollSelectionToMiddle list' + continue ui{aScreen=s{rsList=list'}} + else + continue ui{aScreen=s{rsList=list}} + + -- fall through to the list's event handler (handles other [pg]up/down events) VtyEvent ev -> do let ev' = case ev of EvKey (KChar 'k') [] -> EvKey (KUp) [] @@ -323,12 +362,15 @@ rsHandle ui@UIState{ newitems <- handleListEvent ev' rsList continue ui{aScreen=s{rsList=newitems}} -- continue =<< handleEventLensed ui someLens ev + AppEvent _ -> continue ui MouseDown _ _ _ _ -> continue ui MouseUp _ _ _ -> continue ui - where - -- Encourage a more stable scroll position when toggling list items (cf AccountsScreen.hs) - scrollTop = vScrollToBeginning $ viewportScroll RegisterViewport - journalspan = journalDateSpan False j rsHandle _ _ = error "event handler called with wrong screen type, should not happen" + +isBlankElement mel = ((rsItemDate . snd) <$> mel) == Just "" + +rsCenterAndContinue ui = do + scrollSelectionToMiddle $ rsList $ aScreen ui + continue ui \ No newline at end of file diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index 48afeccc8..a4ceafc57 100644 --- a/hledger-ui/Hledger/UI/UIUtils.hs +++ b/hledger-ui/Hledger/UI/UIUtils.hs @@ -11,6 +11,7 @@ import Brick.Widgets.Border.Style -- import Brick.Widgets.Center import Brick.Widgets.Dialog import Brick.Widgets.Edit +import Brick.Widgets.List import Data.List import Data.Maybe import Data.Monoid @@ -54,8 +55,9 @@ helpDialog copts = ,renderKey ("a", "add transaction (hledger add)") ,renderKey ("A", "add transaction (hledger-iadd)") ,renderKey ("E", "open editor") - ,renderKey ("g", "reload data") ,renderKey ("I", "toggle balance assertions") + ,renderKey ("g", "reload data") + ,renderKey ("CTRL-l", "redraw & recenter") ,renderKey ("q", "quit") ,str " " ,str "MANUAL" @@ -255,3 +257,31 @@ margin h v mcolour = \w -> withBorderAttr :: Attr -> Widget Name -> Widget Name withBorderAttr attr = updateAttrMap (applyAttrMappings [(borderAttr, attr)]) +-- | Like brick's continue, but first run some action to modify brick's state. +-- This action does not affect the app state, but might eg adjust a widget's scroll position. +continueWith :: EventM n () -> ui -> EventM n (Next ui) +continueWith brickaction ui = brickaction >> continue ui + +-- | Scroll a list's viewport so that the selected item is centered in the +-- middle of the display area. +scrollToTop :: List Name e -> EventM Name () +scrollToTop list = do + let vpname = list^.listNameL + setTop (viewportScroll vpname) 0 + +-- | Scroll a list's viewport so that the selected item is centered in the +-- middle of the display area. +scrollSelectionToMiddle :: List Name e -> EventM Name () +scrollSelectionToMiddle list = do + let mselectedrow = list^.listSelectedL + vpname = list^.listNameL + mvp <- lookupViewport vpname + case (mselectedrow, mvp) of + (Just selectedrow, Just vp) -> do + let + itemheight = dbg4 "itemheight" $ list^.listItemHeightL + vpheight = dbg4 "vpheight" $ vp^.vpSize._2 + itemsperpage = dbg4 "itemsperpage" $ vpheight `div` itemheight + toprow = dbg4 "toprow" $ max 0 (selectedrow - (itemsperpage `div` 2)) -- assuming ViewportScroll's row offset is measured in list items not screen rows + setTop (viewportScroll vpname) toprow + _ -> return ()