[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