diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index aeea0196b..e6d488b50 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -103,9 +103,10 @@ handleAccountsScreen st@AppState{aScreen=scr@AccountsScreen{asState=is}} e = do Vty.EvKey Vty.KEsc [] -> halt st Vty.EvKey (Vty.KChar 'q') [] -> halt st Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st - Vty.EvKey (Vty.KRight) [] -> continue st' + Vty.EvKey (Vty.KRight) [] -> do + (w,h) <- getViewportSize "accounts" + continue $ screenEnter d args RS2.screen{rs2Size=(w,h)} st where - st' = screenEnter d args RS2.screen st args = case listSelectedElement is of Just (_, ((acct, _, _), _)) -> ["acct:"++accountNameToAccountRegex acct] Nothing -> [] diff --git a/hledger-ui/Hledger/UI/RegisterScreen2.hs b/hledger-ui/Hledger/UI/RegisterScreen2.hs index 2e4d86362..b296577aa 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen2.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen2.hs @@ -26,19 +26,23 @@ import Hledger.UI.UIUtils screen = RegisterScreen2{ rs2State = list "register" V.empty 1 + ,rs2Size = (0,0) ,sInitFn = initRegisterScreen2 ,sDrawFn = drawRegisterScreen2 ,sHandleFn = handleRegisterScreen2 } initRegisterScreen2 :: Day -> [String] -> AppState -> AppState -initRegisterScreen2 d args st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen2{}} = +initRegisterScreen2 d args st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen2{rs2Size=size}} = st{aScreen=s{rs2State=is'}} where is' = -- listMoveTo (length items) $ - list (Name "register") (V.fromList items) 1 + list (Name "register") (V.fromList items') 1 + -- XXX temporary hack: include saved viewport size in list elements + -- for element draw function + items' = zip (repeat size) items (_label,items) = accountTransactionsReport ropts j thisacctq q where -- XXX temp @@ -77,8 +81,8 @@ drawRegisterScreen2 AppState{aopts=_opts, aScreen=RegisterScreen2{rs2State=is}} ] drawRegisterScreen2 _ = error "draw function called with wrong screen type, should not happen" -drawRegisterItem :: Bool -> AccountTransactionsReportItem -> Widget -drawRegisterItem sel item = +drawRegisterItem :: Bool -> ((Int,Int), AccountTransactionsReportItem) -> Widget +drawRegisterItem sel ((w,_h),item) = -- (w,_) <- getViewportSize "register" -- getCurrentViewportSize -- st@AppState{aopts=opts} <- getAppState @@ -99,7 +103,7 @@ drawRegisterItem sel item = acctnames = nub $ sort $ splitOn ", " acctsstr -- XXX in intercalate ", " $ map strip $ lines $ - postingsReportItemAsText defcliopts{width_=Just "160"} $ -- XXX + postingsReportItemAsText defcliopts{width_=Just (show w)} $ mkpostingsReportItem True True PrimaryDate Nothing p totalamt -- fmt = BottomAligned [ -- FormatField False (Just 20) Nothing TotalField diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index 0b1fb4092..461ec1855 100644 --- a/hledger-ui/Hledger/UI/UITypes.hs +++ b/hledger-ui/Hledger/UI/UITypes.hs @@ -36,12 +36,13 @@ data Screen = ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) ,sDrawFn :: AppState -> [Widget] } - deriving (Show) | RegisterScreen2 { - rs2State :: List AccountTransactionsReportItem + rs2Size :: (Int,Int) -- ^ XXX prev screen's viewport size on entering this screen + ,rs2State :: List ((Int,Int), AccountTransactionsReportItem) ,sInitFn :: Day -> [String] -> AppState -> AppState ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) ,sDrawFn :: AppState -> [Widget] } + deriving (Show) instance Show (List a) where show _ = "" diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index f7da5ef8f..73a62928a 100644 --- a/hledger-ui/Hledger/UI/UIUtils.hs +++ b/hledger-ui/Hledger/UI/UIUtils.hs @@ -7,10 +7,12 @@ module Hledger.UI.UIUtils ( ,attrMap ,customAttrMap ,customAttr + ,getViewportSize ) where --- import Control.Lens ((^.)) +import Control.Lens ((^.)) -- import Control.Monad +import Control.Monad.IO.Class -- import Data.Default import Data.Monoid -- import Data.Time.Calendar (Day) @@ -49,4 +51,15 @@ customAttrMap = attrMap V.defAttr ] customAttr :: AttrName + +-- | In the EventM monad, get the named current viewport's width and height, +-- or (0,0) if the named viewport is not found. +getViewportSize :: Name -> EventM (Int,Int) +getViewportSize name = do + mvp <- lookupViewport name + let (w,h) = case mvp of + Just vp -> vp ^. vpSize + Nothing -> (0,0) + return (w,h) + customAttr = listSelectedAttr <> "custom"