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