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

@@ -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
-  -- let h = c^.availHeightL
+    nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ _asList^.listElementsL
-  --     moveSel n l = listMoveBy n l
+    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 'H') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleHistorical ui
-        VtyEvent (EvKey (KChar 'F') []) -> continue $ regenerateScreens j d $ toggleFlat ui
+        VtyEvent (EvKey (KChar 'F') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleFlat ui
-        VtyEvent (EvKey (KChar 'Z') []) -> scrollTop >> (continue $ regenerateScreens j d $ toggleEmpty ui)
+        VtyEvent (EvKey (KChar 'Z') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleEmpty ui
-        VtyEvent (EvKey (KChar 'U') []) -> scrollTop >> (continue $ regenerateScreens j d $ toggleUnmarked ui)
+        VtyEvent (EvKey (KChar 'U') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleUnmarked ui
-        VtyEvent (EvKey (KChar 'P') []) -> scrollTop >> (continue $ regenerateScreens j d $ togglePending ui)
+        VtyEvent (EvKey (KChar 'P') []) -> asCenterAndContinue $ regenerateScreens j d $ togglePending ui
-        VtyEvent (EvKey (KChar 'C') []) -> scrollTop >> (continue $ regenerateScreens j d $ toggleCleared ui)
+        VtyEvent (EvKey (KChar 'C') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleCleared ui
-        VtyEvent (EvKey (KChar 'R') []) -> scrollTop >> (continue $ regenerateScreens j d $ toggleReal 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

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,6 +259,10 @@ 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 ->
@@ -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 'H') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleHistorical ui
-        VtyEvent (EvKey (KChar 'F') []) -> scrollTop >> (continue $ regenerateScreens j d $ toggleFlat ui)
+        VtyEvent (EvKey (KChar 'F') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleFlat ui
-        VtyEvent (EvKey (KChar 'Z') []) -> scrollTop >> (continue $ regenerateScreens j d $ toggleEmpty ui)
+        VtyEvent (EvKey (KChar 'Z') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleEmpty ui
-        VtyEvent (EvKey (KChar 'U') []) -> scrollTop >> (continue $ regenerateScreens j d $ toggleUnmarked ui)
+        VtyEvent (EvKey (KChar 'U') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleUnmarked ui
-        VtyEvent (EvKey (KChar 'P') []) -> scrollTop >> (continue $ regenerateScreens j d $ togglePending ui)
+        VtyEvent (EvKey (KChar 'P') []) -> rsCenterAndContinue $ regenerateScreens j d $ togglePending ui
-        VtyEvent (EvKey (KChar 'C') []) -> scrollTop >> (continue $ regenerateScreens j d $ toggleCleared ui)
+        VtyEvent (EvKey (KChar 'C') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleCleared ui
-        VtyEvent (EvKey (KChar 'R') []) -> scrollTop >> (continue $ regenerateScreens j d $ toggleReal ui)
+        VtyEvent (EvKey (KChar 'R') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleReal ui
-        VtyEvent (EvKey (KChar '/') []) -> (continue $ regenerateScreens j d $ showMinibuffer 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

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