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

ui: listScrollPushingSelection: do scroll if there's no selection

Browse Source
This commit is contained in:
Simon Michael 2021-11-18 08:27:55 -10:00
parent 7bbff6a359
commit 710c054589
1 changed files with 13 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
hledger-ui/Hledger/UI/UIUtils.hs
View File

@ -363,21 +363,23 @@ reportSpecSetFutureAndForecast d forecast rspec =
,Not generatedTransactionTag ,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). -- 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. -- The selection will be moved when necessary to keep it visible and allow the scroll.
listScrollPushingSelection :: (Ord n, Foldable t, Splittable t) => listScrollPushingSelection :: (Ord n, Foldable t, Splittable t) =>
n -> GenericList n t e -> Int -> Int -> EventM n (GenericList n t e) n -> GenericList n t e -> Int -> Int -> EventM n (GenericList n t e)
listScrollPushingSelection name list listheight scrollamt = do listScrollPushingSelection name list listheight scrollamt = do
viewportScroll name `vScrollBy` scrollamt
mvp <- lookupViewport name mvp <- lookupViewport name
let mselidx = listSelected list case mvp of
case (mvp, mselidx) of Just VP{_vpTop, _vpSize=(_,vpheight)} -> do
(Just VP{_vpTop, _vpSize=(_,vpheight)}, Just selidx) -> do let mselidx = listSelected list
viewportScroll name `vScrollBy` scrollamt case mselidx of
return $ pushsel list Just selidx -> return $ pushsel list
where where
pushsel pushsel
| scrollamt > 0, selidx <= _vpTop && selidx < (listheight-1) = listMoveDown | scrollamt > 0, selidx <= _vpTop && selidx < (listheight-1) = listMoveDown
| scrollamt < 0, selidx >= _vpTop + vpheight - 1 && selidx > 0 = listMoveUp | scrollamt < 0, selidx >= _vpTop + vpheight - 1 && selidx > 0 = listMoveUp
| otherwise = id | otherwise = id
_ -> return list
_ -> return list _ -> return list