[xmonad] darcs patch: broadcastMessage now uses Operations.windows to update...

[David Roundy]

On Thu, Feb 21, 2008 at 03:21:45PM +0100, Andrea Rossato wrote:
> hi,
> 
> this is a follow up of my previous "broadcastMessage should not call
> modify".
> 
> This is a proposal of the new approach, in order to show that it fixes
> the issue #111.
> 
> Cheers,
> Andrea
> 
> (ps: sorry for the noise, but I think this is urgent, as issue #142
> shows.)
> 
> Thu Feb 21 15:18:50 CET 2008  Andrea Rossato <andrea.rossato at unibz.it>
>   * broadcastMessage now uses Operations.windows to update the windowset
>   This is a fix for issue #111:
>   - broadcastMessage and restart moved to Operations;
>   - added sendMessageToVisible and sendMessageToHidden
>   - broadcastMessage will use sendMessage* functions now.
>     
>   TODO: remove Core.runOnWorkspaces and refactor sendMessageToWorkspaces
>   accordingly.

...

> +-- | Send a message to all visible layouts, without necessarily refreshing.
> +-- This is how we implement the hooks, such as UnDoLayout.
> +broadcastMessage :: Message a => a -> X ()
> +broadcastMessage a = withWindowSet $ \ws -> do
> +    sendMessage a
> +    mapM_ (sendMessageToVisible a) (map W.workspace . W.visible $ ws)
> +    mapM_ (sendMessageToHidden  a) (W.hidden ws)

I think broadcastMessage needs reworking, and should be reworked somewhat
along the lines of your sendMessageToWorkspace idea that you previously
implemented (but in a buggy way).

The trouble here is that if any of these doLayouts modify the windowset,
I'm afraid we'll run into trouble as we continue sending the Message to the
other workspaces, but passing those funcitons a W.Workspace that's obsolete
(e.g. maybe its layout changed because of an action by a previous
handleMessage).  This *may* not cause trouble, but I think it's safer to
write

sendMessageToWorkspaceWithoutNecessarilyRefreshing :: Message a => a -> WorkspaceId -> X ()

(but ideally with a shorter name)

and then

broadcastMessage :: Message a => a -> X ()
broadcastMessage a = withWindowSet $ \ws -> do
    sendMessage a
    mapM_ (sendMessageToWorkspaceWithoutNecessarilyRefreshing a)
          (map W.tag $ (map W.workspace $ W.visible ws) ++ W.hidden ws)

It seems like with this function, each workspace that exists will get the
message, unless its WorkspaceId changes first.  It's possible that a
workspace will get the message never, or more than once, if its WorkspaceId
changes, but that's almost unavoidable.  But the key feature of this
approach is:  if the state is changed by a handleMessage (including changes
to layouts), then that change will not be lost... unless a layout both
changes the windowset *and* returns a modified layout.

But the key is that any loss of that sort must happen within a single
sendMessageToWorkspaceWithoutNecessarilyRefreshing call (or in the
sendMessage call).  So those two functions (each of which call a single
handleMessage) are the only two that place a limit on what is "safe" for a
handleMessage to do.  And with just a bit of care they can actually be
pretty forgiving.  As you point out, a handleMessage that returns Nothing
should be able to make *any* X calls, with the worst danger being the
introduction of an infinite loop (a real danger, but also unavoidable).

> +sendMessageToVisible :: Message a => a -> W.Workspace WorkspaceId (Layout Window) Window -> X ()
> +sendMessageToVisible a w = do
> +    ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
> +    whenJust ml' $ \l' -> windows $ \ws -> ws { W.visible = nvis l' ws }
> +        where nvis l ws' = foldr (f l) [] (W.visible ws')
> +              f lay x xs = if (W.tag . W.workspace $ x) == (W.tag w)
> +                           then x { W.workspace = (W.workspace x) { W.layout = lay }} :  xs
> +                           else x : xs
> +
> +sendMessageToHidden :: Message a => a -> W.Workspace WorkspaceId (Layout Window) Window -> X ()
> +sendMessageToHidden a w = do
> +    ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
> +    whenJust ml' $ \l' -> windows $ \ws -> ws { W.hidden = nhid l' ws }
> +        where nhid l ws' = foldr (f l) [] (W.hidden ws')
> +              f lay x xs = if (W.tag x) == (W.tag w)
> +                           then x { W.layout = lay } : xs
> +                           else x : xs
> +