Add config to choose auto scroll on focus change. Defaults to True

src/Monomer/Core/ThemeTypes.hs

@@ -65,6 +65,7 @@ data ThemeState = ThemeState {
   _thsRadioWidth :: Double,
   _thsRadioStyle :: StyleState,
   _thsScrollOverlay :: Bool,
+  _thsScrollFollowFocus :: Bool,
   _thsScrollBarColor :: Color,
   _thsScrollThumbColor :: Color,
   _thsScrollBarWidth :: Double,
@@ -106,6 +107,7 @@ instance Default ThemeState where
     _thsRadioWidth = def,
     _thsRadioStyle = def,
     _thsScrollOverlay = False,
+    _thsScrollFollowFocus = True,
     _thsScrollBarColor = def,
     _thsScrollThumbColor = def,
     _thsScrollBarWidth = 10,

src/Monomer/Core/Themes/BaseTheme.hs

@@ -192,6 +192,7 @@ baseBasic themeMod = def
   & L.radioWidth .~ 20
   & L.radioStyle . L.fgColor ?~ inputFgBasic themeMod
   & L.scrollOverlay .~ False
+  & L.scrollFollowFocus .~ True
   & L.scrollBarColor .~ scrollBarBasic themeMod
   & L.scrollThumbColor .~ scrollThumbBasic themeMod
   & L.scrollBarWidth .~ 10

src/Monomer/Main/Handlers.hs

@@ -299,10 +299,11 @@ handleSetFocus newFocus (wenv, root, reqs, evts) =  do
   if oldFocus /= newFocus
     then do
       (wenv1, root1, reqs1, evts1) <- handleSystemEvent wenv0 Blur oldFocus root
+      let tempWenv = wenv1 { _weFocusedPath = newFocus }
 
       L.focusedPath .= newFocus
       L.renderRequested .= True
-      (wenv2, root2, reqs2, evts2) <- handleSystemEvent wenv1 Focus newFocus root1
+      (wenv2, root2, reqs2, evts2) <- handleSystemEvent tempWenv Focus newFocus root1
 
       return (wenv2, root2, reqs <> reqs1 <> reqs2, evts <> evts1 <> evts2)
     else

src/Monomer/Widgets/Scroll.hs

@@ -14,6 +14,7 @@ module Monomer.Widgets.Scroll (
   vscroll,
   vscroll_,
   scrollOverlay,
+  scrollFollowFocus,
   scrollWheelRate,
   scrollBarHoverColor,
   scrollBarColor,
@@ -27,7 +28,7 @@ module Monomer.Widgets.Scroll (
 
 import Codec.Serialise
 import Control.Applicative ((<|>))
-import Control.Lens (ALens', (&), (^.), (.~), (^?!), (<>~), (%~), cloneLens, ix)
+import Control.Lens (ALens', (&), (^.), (.~), (^?), (^?!), (<>~), (%~), _Just, cloneLens, ix)
 import Control.Monad
 import Data.Default
 import Data.Maybe
@@ -54,6 +55,7 @@ data ActiveBar
 data ScrollCfg = ScrollCfg {
   _scScrollType :: Maybe ScrollType,
   _scScrollOverlay :: Maybe Bool,
+  _scFollowFocus :: Maybe Bool,
   _scWheelRate :: Maybe Double,
   _scBarColor :: Maybe Color,
   _scBarHoverColor :: Maybe Color,
@@ -69,6 +71,7 @@ instance Default ScrollCfg where
   def = ScrollCfg {
     _scScrollType = Nothing,
     _scScrollOverlay = Nothing,
+    _scFollowFocus = Nothing,
     _scWheelRate = Nothing,
     _scBarColor = Nothing,
     _scBarHoverColor = Nothing,
@@ -84,6 +87,7 @@ instance Semigroup ScrollCfg where
   (<>) t1 t2 = ScrollCfg {
     _scScrollType = _scScrollType t2 <|> _scScrollType t1,
     _scScrollOverlay = _scScrollOverlay t2 <|> _scScrollOverlay t1,
+    _scFollowFocus = _scFollowFocus t2 <|> _scFollowFocus t1,
     _scWheelRate = _scWheelRate t2 <|> _scWheelRate t1,
     _scBarColor = _scBarColor t2 <|> _scBarColor t1,
     _scBarHoverColor = _scBarHoverColor t2 <|> _scBarHoverColor t1,
@@ -116,6 +120,11 @@ scrollOverlay overlay = def {
   _scScrollOverlay = Just overlay
 }
 
+scrollFollowFocus :: Bool -> ScrollCfg
+scrollFollowFocus follow = def {
+  _scFollowFocus = Just follow
+}
+
 scrollWheelRate :: Double -> ScrollCfg
 scrollWheelRate rate = def {
   _scWheelRate = Just rate
@@ -245,6 +254,14 @@ makeScroll config state = widget where
       & L.widget .~ makeScroll config oldState
 
   handleEvent wenv target evt node = case evt of
+    Focus -> result where
+      follow = fromMaybe (theme ^. L.scrollFollowFocus) (_scFollowFocus config)
+      focusPath = wenv ^. L.focusedPath
+      focusInst = widgetFindByPath (node ^. L.widget) wenv focusPath node
+      focusVp = focusInst ^? _Just . L.viewport
+      result
+        | follow = focusVp >>= scrollTo wenv node
+        | otherwise = Nothing
     ButtonAction point btn status _ -> result where
       leftPressed = status == PressedBtn && btn == wenv ^. L.mainButton
       btnReleased = status == ReleasedBtn && btn == wenv ^. L.mainButton

tasks.md

@@ -476,6 +476,7 @@
   - Add widgetFindByPath
   - Do something about Serialise. Temporarily hide from composite?
     - Added WidgetModel typeclass. Provides a way of not forcing users to implement Serialise
+  - Allow opting out of scroll bar overlaid on top of content
 
 - Pending
   - Add header in all files, indicating license and documenting what the module does
@@ -494,13 +495,13 @@
     - https://stackoverflow.com/questions/51275681/how-to-include-a-dependency-c-library-in-haskell-stack
 
 Next
-  - Allow opting out of scroll bar overlaid on top of content
   - Add scroll focus following
   - Resize called multiple times after window resize?
   - Add combinator to affect size factor only
   - Should cascadeCtx be part of widget interface? Maybe it can be handled on init?
     - This could avoid rebuilding listView items when hidden/shown
   - Check resize requests on Todo when entering text in description
+    - Review how sizeReq is updated. Custom user value may be ignored on further resizes
   - Improve test utilities
     - Some way to combine them, avoid this noInit thing, losing of focus, etc
     - Test image updating WidgetId/Path

test/unit/Monomer/Widgets/ScrollSpec.hs

@@ -9,15 +9,53 @@ import qualified Data.Sequence as Seq
 import Monomer.Core
 import Monomer.Core.Combinators
 import Monomer.Event
+import Monomer.TestEventUtil
 import Monomer.TestUtil
+import Monomer.Widgets.Button
 import Monomer.Widgets.Label
 import Monomer.Widgets.Scroll
+import Monomer.Widgets.Stack
 
 import qualified Monomer.Lens as L
 
+data ButtonEvt
+  = Button1
+  | Button2
+  deriving (Eq, Show)
+
 spec :: Spec
 spec = describe "Scroll" $ do
+  handleEvent
   resize
+
+handleEvent :: Spec
+handleEvent = describe "handleEvent" $ do
+  handleChildrenFocus
+
+handleChildrenFocus :: Spec
+handleChildrenFocus = describe "handleChildrenFocus" $ do
+  it "should not follow focus events" $
+    evtsIgnore evts `shouldBe` Seq.fromList [Button1]
+
+  it "should follow focus events" $
+    evtsFollow evts `shouldBe` Seq.fromList [Button2]
+
+  where
+    wenv = mockWenv () & L.windowSize .~ Size 640 480
+    point = Point 320 200
+    evts = [evtK keyTab, evtClick point]
+    stackNode = vstack [
+        button "Button 1" Button1 `style` [width 640, height 480],
+        button "Button 2" Button2 `style` [width 640, height 480]
+      ]
+    ignoreNode = scroll_ [scrollFollowFocus False] stackNode
+    followNode = scroll stackNode
+    evtsIgnore es = nodeHandleEventEvts wenv es ignoreNode
+    evtsFollow es = nodeHandleEventEvts wenv es followNode
+
+resize :: Spec
+resize = describe "resize" $ do
+  resizeLarge
   resizeSmall
   resizeOverlaySmall
   resizeH
@@ -25,8 +63,8 @@ spec = describe "Scroll" $ do
   resizeOverlayH
   resizeOverlayV
 
-resize :: Spec
-resize = describe "resize" $ do
+resizeLarge :: Spec
+resizeLarge = describe "resizeLarge" $ do
   it "should have the provided viewport size" $
     viewport `shouldBe` vp