[xmonad] darcs patch: Add EventHook: a layout modifier to hand... (and 8 more)

Don Stewart dons at galois.com
Sat Mar 22 17:52:25 EDT 2008


droundy:
> On Sat, Mar 22, 2008 at 12:12:06PM -0700, Don Stewart wrote:
> > > On Sat, Mar 22, 2008 at 10:34:35AM -0700, Don Stewart wrote:
> > > > Patches to the core are expected to reach a higher standard of assurance
> > > > than patches to the contrib modules. This is to ensure we retain the
> > > > stability for the core feature set.
> > > >
> > > > I would hope people agree that this policy has helped contribute to
> > > > robustness and reliability of the core system over several releases now.
> > > 
> > > That's a good policy, unfortunately inconsistently enforced, which is what
> > > causes the trouble.  see e.g. a patch which apparently went into core
> > > without review
> > > 
> > > Thu Dec 27 00:03:56 PST 2007  Spencer Janssen <sjanssen at cse.unl.edu>
> > >   * Broadcast button events to all layouts, fix for issue #111
> > > 
> > > which fixed no bugs (so far as anyone can tell) and introduced new bugs,
> > > but was never rolled back, because sjanssen felt that it was *morally*
> > > right, in spite of its causing regressions.
> > 
> > I'm more than happy to consider any patches that fix regressions, close
> > bugs, or enable new features. Particularly if they come with
> > risk/benefit summaries, tests, and are written to inspire confidence in the code.
> > 
> > If David and/or Joachim would like to collaborate to come up with a
> > solution that satisifies all parties to #111, I'm happy to look at it!
> 
> See Andreas' patch from February 23
> 
> http://www.haskell.org/pipermail/xmonad/2008-February/004860.html
> 
> the problem is already solved, it's just that noone looked at it.

I've attached a polished version of this. 

Can you and Joachim confirm that this fixes the regressions described,
and could close #111 ?

-- Don
-------------- next part --------------

New patches:

[add sendMessageWithNoRefresh and have broadcastMessage use it
Andrea Rossato <andrea.rossato at unibz.it>**20080223130702
 
 This patch:
 - moves broadcastMessage and restart from Core to Operations (to avoid
   circular imports);
 - in Operations introduces sendMessageWithNoRefresh and move
  updateLayout outside windows.
 - broadcastMessage now uses sendMessageWithNoRefresh to obey to this
   rules:
   1. if handleMessage returns Nothing no action is taken;
   2. if handleMessage returns a Just ml *only* the layout field of the
      workspace record will be updated.
] {
hunk ./XMonad/Core.hs 28
-    withDisplay, withWindowSet, isRoot, runOnWorkspaces, broadcastMessage,
-    getAtom, spawn, restart, getXMonadDir, recompile, trace, whenJust, whenX,
+    withDisplay, withWindowSet, isRoot, runOnWorkspaces,
+    getAtom, spawn, getXMonadDir, recompile, trace, whenJust, whenX,
hunk ./XMonad/Core.hs 356
--- | 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 = runOnWorkspaces $ \w -> do
-    ml' <- handleMessage (layout w) (SomeMessage a) `catchX` return Nothing
-    return $ w { layout = maybe (layout w) id ml' }
-
hunk ./XMonad/Core.hs 366
--- | @restart name resume at . Attempt to restart xmonad by executing the program
--- @name at .  If @resume@ is 'True', restart with the current window state.
--- When executing another window manager, @resume@ should be 'False'.
---
-restart :: String -> Bool -> X ()
-restart prog resume = do
-    broadcastMessage ReleaseResources
-    io . flush =<< asks display
-    args <- if resume then gets (("--resume":) . return . showWs . windowset) else return []
-    catchIO (executeFile prog True args Nothing)
- where showWs = show . mapLayout show
-
hunk ./XMonad/Operations.hs 39
+import System.Posix.Process (executeFile)
hunk ./XMonad/Operations.hs 125
-        gottenhidden    = filter (`elem` tags_oldvisible) $ map W.tag $ W.hidden ws
-    sendMessageToWorkspaces Hide gottenhidden
+        gottenhidden    = filter (flip elem tags_oldvisible . W.tag) $ W.hidden ws
+    mapM_ (sendMessageWithNoRefresh Hide) gottenhidden
hunk ./XMonad/Operations.hs 148
-        whenJust ml' $ \l' -> runOnWorkspaces (\ww -> if W.tag ww == n
-                                                      then return $ ww { W.layout = l'}
-                                                      else return ww)
+        updateLayout n ml'
hunk ./XMonad/Operations.hs 340
--- | Send a message to a list of workspaces' layouts, without necessarily refreshing.
-sendMessageToWorkspaces :: Message a => a -> [WorkspaceId] -> X ()
-sendMessageToWorkspaces a l = runOnWorkspaces $ \w ->
-   if W.tag w `elem` l
-      then do ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
-              return $ w { W.layout = maybe (W.layout w) id ml' }
-      else return w
+-- | Send a message to all layouts, without refreshing.
+broadcastMessage :: Message a => a -> X ()
+broadcastMessage a = withWindowSet $ \ws -> do
+                       let c = W.workspace . W.current $ ws
+                           v = map W.workspace . W.visible $ ws
+                           h = W.hidden ws
+                       mapM_ (sendMessageWithNoRefresh a) (c : v ++ h)
+
+-- | Send a message to a layout, without refreshing.
+sendMessageWithNoRefresh :: Message a => a -> W.Workspace WorkspaceId (Layout Window) Window -> X ()
+sendMessageWithNoRefresh a w =
+  handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing >>=
+  updateLayout  (W.tag    w)
+
+-- | Update the layout field of a workspace
+updateLayout :: WorkspaceId -> Maybe (Layout Window) -> X ()
+updateLayout i ml = whenJust ml $ \l ->
+                    runOnWorkspaces $ \ww -> if W.tag ww == i
+                                             then return $ ww { W.layout = l}
+                                             else return ww
hunk ./XMonad/Operations.hs 402
+-- | @restart name resume at . Attempt to restart xmonad by executing the program
+-- @name at .  If @resume@ is 'True', restart with the current window state.
+-- When executing another window manager, @resume@ should be 'False'.
+restart :: String -> Bool -> X ()
+restart prog resume = do
+    broadcastMessage ReleaseResources
+    io . flush =<< asks display
+    args <- if resume then gets (("--resume":) . return . showWs . windowset) else return []
+    catchIO (executeFile prog True args Nothing)
+ where showWs = show . W.mapLayout show
+
}

[clean up for style
Don Stewart <dons at galois.com>**20080322214116] {
hunk ./XMonad/Operations.hs 146
-        (rs, ml') <- runLayout wsp { W.stack = tiled } viewrect`catchX` runLayout wsp { W.layout = Layout Full, W.stack = tiled } viewrect
+        (rs, ml') <- runLayout wsp { W.stack = tiled } viewrect `catchX`
+                     runLayout wsp { W.stack = tiled, W.layout = Layout Full } viewrect
hunk ./XMonad/Operations.hs 344
-                       let c = W.workspace . W.current $ ws
-                           v = map W.workspace . W.visible $ ws
-                           h = W.hidden ws
-                       mapM_ (sendMessageWithNoRefresh a) (c : v ++ h)
+   let c = W.workspace . W.current $ ws
+       v = map W.workspace . W.visible $ ws
+       h = W.hidden ws
+   mapM_ (sendMessageWithNoRefresh a) (c : v ++ h)
hunk ./XMonad/Operations.hs 352
-  handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing >>=
-  updateLayout  (W.tag    w)
+    handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing >>=
+    updateLayout  (W.tag w)
hunk ./XMonad/Operations.hs 358
-                    runOnWorkspaces $ \ww -> if W.tag ww == i
-                                             then return $ ww { W.layout = l}
-                                             else return ww
+    runOnWorkspaces $ \ww -> return $ if W.tag ww == i then ww { W.layout = l} else ww
hunk ./XMonad/Operations.hs 401
+------------------------------------------------------------------------
+
}

Context:

[more properties for splitting horizontally and vertically
Don Stewart <dons at galois.com>**20080322201835] 
[test message handling of Full layout
Don Stewart <dons at galois.com>**20080322192728] 
[formatting
Don Stewart <dons at galois.com>**20080322192635] 
[strict fields on layout messages
Don Stewart <dons at galois.com>**20080322192248] 
[QuickCheck properties to fully specify the Tall layout, and its messages
Don Stewart <dons at galois.com>**20080322041801] 
[clean up Layout.hs, not entirely happy about the impure layouts.
Don Stewart <dons at galois.com>**20080322041718] 
[comments
Don Stewart <dons at galois.com>**20080322041654] 
[add hpc generation script
Don Stewart <dons at galois.com>**20080322041640] 
[add QuickCheck property for Full: it produces one window, it is fullscreen, and it is the current window
Don Stewart <dons at galois.com>**20080322002026] 
[QC for pureLayout. confirm pureLayout . Tall produces no overlaps
Don Stewart <dons at galois.com>**20080322001229] 
[whitespace
Don Stewart <dons at galois.com>**20080322001208] 
[reenable quickcheck properties for layouts (no overlap, fullscreen)
Don Stewart <dons at galois.com>**20080321234015] 
[formatting
Don Stewart <dons at galois.com>**20080321230956] 
[Revert float location patch. Not Xinerama safe
Don Stewart <dons at galois.com>**20080321214129] 
[Small linecount fix :)
robreim at bobturf.org**20080308021939] 
[Change floats to always use the current screen
robreim at bobturf.org**20080308015829] 
[XMonad.Core: ignore SIGPIPE, let write calls throw
Lukas Mai <l.mai at web.de>**20080321171911] 
[update documentation
Brent Yorgey <byorgey at gmail.com>**20080311160727] 
[Reimplement Mirror with runLayout
Andrea Rossato <andrea.rossato at unibz.it>**20080225083236] 
[Reimplement Choose with runLayout
Andrea Rossato <andrea.rossato at unibz.it>**20080222193119] 
[runLayout is now a LayoutClass method and takes the Workspace and the screen Rectangle
Andrea Rossato <andrea.rossato at unibz.it>**20080222175815] 
[add property for ensureTags behaviour on hidden workspaces
Don Stewart <dons at galois.com>**20080310182557] 
[use -fhpc by default when testing. All developers should have 6.8.x
Don Stewart <dons at galois.com>**20080307184223] 
[more general properties for view, greedyView
Don Stewart <dons at galois.com>**20080307181657] 
[rework failure cases in StackSet.view
Don Stewart <dons at galois.com>**20080307181634] 
[bit more code coverage
Don Stewart <dons at galois.com>**20080307180905] 
[more tests. slightly better test coverage
Don Stewart <dons at galois.com>**20080227180113] 
[test geometry setting
Don Stewart <dons at galois.com>**20080227175554] 
[incorrect invariant test for greedyView
Don Stewart <dons at galois.com>**20080225180350] 
[update LOC claim in man page
gwern0 at gmail.com**20080215211420] 
[Add a startupHook.
Brent Yorgey <byorgey at gmail.com>**20080204192445
 The only thing I am not sure about here is at what exact point the 
 startupHook should get run.  I picked a place that seems to make sense: 
 as late as possible, right before entering the main loop.  That way all
 the layouts/workspaces/other state are set up and the startupHook can
 manipulate them.
] 
[Core.hs: add an Applicative instance for X
Brent Yorgey <byorgey at gmail.com>**20080204192348] 
[add quickstart instructions
Don Stewart <dons at galois.com>**20080212203502] 
[Remove non-existent windows on restart
Spencer Janssen <sjanssen at cse.unl.edu>**20080207091140] 
[Lift initColor exceptions into Maybe
Don Stewart <dons at galois.com>**20080206194858
 
 We should audit all X11 Haskell lib calls we make for whether
 they throw undocumented exceptions, and then banish that.
 
] 
[some things to do
Don Stewart <dons at galois.com>**20080206192533] 
[module uses CPP
Don Stewart <dons at galois.com>**20080206190521] 
[Rename runManageHook to runQuery
Spencer Janssen <sjanssen at cse.unl.edu>**20080204053336] 
[let enter dismiss compile errors
daniel at wagner-home.com**20080203202852] 
[Core.hs, StackSet.hs: some documentation updates
Brent Yorgey <byorgey at gmail.com>**20080201190653] 
[Make Mirror implement emptyLayout
Andrea Rossato <andrea.rossato at unibz.it>**20080128001834] 
[xmonad.cabal: add `build-type' to make Cabal happy
"Valery V. Vorotyntsev" <valery.vv at gmail.com>**20080131163213] 
[Get version from the Paths_xmonad module generated by Cabal
Daniel Neri <daniel.neri at sigicom.se>**20080129144037
 No need to bump version in more than one place.
] 
[Kill stale xmonad 0.1 comments
Spencer Janssen <sjanssen at cse.unl.edu>**20080128211418] 
[Point to 0.6 release of contrib
Spencer Janssen <sjanssen at cse.unl.edu>**20080128101115] 
[notes on releases
Don Stewart <dons at galois.com>**20080128171012] 
[Generalize the type of catchIO, use it in Main.hs
Spencer Janssen <sjanssen at cse.unl.edu>**20080128054651] 
[Add emptyLayout to LayoutClass, a method to be called when a workspace is empty
Andrea Rossato <andrea.rossato at unibz.it>**20080124013207] 
[bump output of --version
Don Stewart <dons at galois.com>**20080128170840] 
[clarify copyright
Don Stewart <dons at galois.com>**20080108185640] 
[Broadcast button events to all layouts, fix for issue #111
Spencer Janssen <sjanssen at cse.unl.edu>**20071227080356] 
[TAG 0.6
Spencer Janssen <sjanssen at cse.unl.edu>**20080127220633] 
Patch bundle hash:
faef9c2195028d87677c3f2fcfcfe6d34c36a77e


More information about the xmonad mailing list