From 710c0545893ffd801e34db39982be8e845821607 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 18 Nov 2021 08:27:55 -1000 Subject: [PATCH] ui: listScrollPushingSelection: do scroll if there's no selection --- hledger-ui/Hledger/UI/UIUtils.hs | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index cc2399a3d..383e53d3c 100644 --- a/hledger-ui/Hledger/UI/UIUtils.hs +++ b/hledger-ui/Hledger/UI/UIUtils.hs @@ -363,21 +363,23 @@ reportSpecSetFutureAndForecast d forecast rspec = ,Not generatedTransactionTag ] --- Vertically scroll the named list with the given number of non-empty items +-- Vertically scroll the named list's viewport with the given number of non-empty items -- by the given positive or negative number of items (usually 1 or -1). -- The selection will be moved when necessary to keep it visible and allow the scroll. listScrollPushingSelection :: (Ord n, Foldable t, Splittable t) => n -> GenericList n t e -> Int -> Int -> EventM n (GenericList n t e) listScrollPushingSelection name list listheight scrollamt = do + viewportScroll name `vScrollBy` scrollamt mvp <- lookupViewport name - let mselidx = listSelected list - case (mvp, mselidx) of - (Just VP{_vpTop, _vpSize=(_,vpheight)}, Just selidx) -> do - viewportScroll name `vScrollBy` scrollamt - return $ pushsel list - where - pushsel - | scrollamt > 0, selidx <= _vpTop && selidx < (listheight-1) = listMoveDown - | scrollamt < 0, selidx >= _vpTop + vpheight - 1 && selidx > 0 = listMoveUp - | otherwise = id + case mvp of + Just VP{_vpTop, _vpSize=(_,vpheight)} -> do + let mselidx = listSelected list + case mselidx of + Just selidx -> return $ pushsel list + where + pushsel + | scrollamt > 0, selidx <= _vpTop && selidx < (listheight-1) = listMoveDown + | scrollamt < 0, selidx >= _vpTop + vpheight - 1 && selidx > 0 = listMoveUp + | otherwise = id + _ -> return list _ -> return list