From ac881f1e18f1e41924e7526faf17c5f1f5022b81 Mon Sep 17 00:00:00 2001 From: David Roundy Date: Sat, 12 May 2007 23:56:44 +0200 Subject: make mosaic configure windows by name rather than by Window. Note that this is still pretty flawed. Often window names change, and the layout then stagnates a bit. Gimp, for example, opens most its windows with the same name before renaming them, so you have to hit mod-return or something to force a doLayout. Also, gimp still overrides xmonad regarding the size of its main window. :( darcs-hash:20070512215644-72aca-85bc925412c0daac97b751dafe6d3b8933e2d234.gz --- Mosaic.hs | 69 ++++++++++++++++++++++++++++++++++++++------------------------- 1 file changed, 42 insertions(+), 27 deletions(-) (limited to 'Mosaic.hs') diff --git a/Mosaic.hs b/Mosaic.hs index 61b814e..2d9cc60 100644 --- a/Mosaic.hs +++ b/Mosaic.hs @@ -1,4 +1,5 @@ -module XMonadContrib.Mosaic ( mosaic, expandWindow, shrinkWindow, squareWindow ) where +module XMonadContrib.Mosaic ( mosaic, expandWindow, shrinkWindow, squareWindow, + getName, withNamedWindow ) where -- This module defines a "mosaic" layout, which tries to give all windows -- equal area, while also trying to give them a user-defined (and run-time @@ -13,8 +14,6 @@ module XMonadContrib.Mosaic ( mosaic, expandWindow, shrinkWindow, squareWindow ) -- You can use this module with the following in your config file: -- import XMonadContrib.Mosaic --- import Control.Monad.State ( gets ) --- import qualified StackSet as W ( peek ) -- defaultLayouts :: [Layout] -- defaultLayouts = [ mosaic (1%4) (1%2) M.empty M.empty, full, @@ -22,18 +21,16 @@ module XMonadContrib.Mosaic ( mosaic, expandWindow, shrinkWindow, squareWindow ) -- In the key-bindings, do something like: --- , ((modMask .|. shiftMask, xK_h ), do ws <- gets workspace --- whenJust (W.peek ws) $ \w -> --- layoutMsg (shrinkWindow w)) --- , ((modMask .|. shiftMask, xK_l ), do ws <- gets workspace --- whenJust (W.peek ws) $ \w -> --- layoutMsg (expandWindow w)) --- , ((modMask .|. shiftMask, xK_s ), do ws <- gets workspace --- whenJust (W.peek ws) $ \w -> --- layoutMsg (squareWindow w)) +-- , ((modMask .|. shiftMask, xK_h ), withNamedWindow (sendMessage . shrinkWindow)) +-- , ((modMask .|. shiftMask, xK_l ), withNamedWindow (sendMessage . expandWindow)) +-- , ((modMask .|. shiftMask, xK_s ), withNamedWindow (sendMessage . squareWindow)) +import Control.Monad.Reader ( asks ) +import Control.Monad.State ( gets ) +import qualified StackSet as W ( peek ) import Data.Ratio import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras ( fetchName ) import XMonad import Operations ( Resize(Shrink, Expand) ) import qualified Data.Map as M @@ -43,17 +40,17 @@ import Control.Monad ( mplus ) import System.IO.Unsafe -data HandleWindow = ExpandWindow Window | ShrinkWindow Window | SquareWindow Window +data HandleWindow = ExpandWindow NamedWindow | ShrinkWindow NamedWindow | SquareWindow NamedWindow deriving ( Typeable, Eq ) instance Message HandleWindow -expandWindow, shrinkWindow, squareWindow :: Window -> HandleWindow +expandWindow, shrinkWindow, squareWindow :: NamedWindow -> HandleWindow expandWindow = ExpandWindow shrinkWindow = ShrinkWindow squareWindow = SquareWindow -mosaic :: Rational -> Rational -> M.Map Window WindowRater -> M.Map Window Area -> Layout +mosaic :: Rational -> Rational -> M.Map NamedWindow WindowRater -> M.Map NamedWindow Area -> Layout mosaic delta tileFrac raters areas = Layout { doLayout = mosaicL tileFrac raters areas , modifyLayout = mlayout } where mlayout x = (m1 `fmap` fromMessage x) `mplus` (m2 `fmap` fromMessage x) @@ -77,28 +74,35 @@ myerror :: String -> a myerror s = seq foo $ error s where foo = unsafePerformIO $ appendFile "/tmp/xmonad.trace" (s++"\n") -multiply_area :: Area -> Window -> M.Map Window Area -> M.Map Window Area +multiply_area :: Area -> NamedWindow -> M.Map NamedWindow Area -> M.Map NamedWindow Area multiply_area a w = M.alter (Just . f) w where f Nothing = a f (Just a') = a'*a -add_rater :: WindowRater -> Window -> M.Map Window WindowRater -> M.Map Window WindowRater +add_rater :: WindowRater -> NamedWindow -> M.Map NamedWindow WindowRater -> M.Map NamedWindow WindowRater add_rater r w = M.alter f w where f Nothing= Just r f (Just r') = Just $ \foo bar -> r foo bar + r' foo bar -type WindowRater = Window -> Rectangle -> Rational +type WindowRater = NamedWindow -> Rectangle -> Rational -mosaicL :: Rational -> M.Map Window WindowRater -> M.Map Window Area - -> Rectangle -> [Window] -> [(Window, Rectangle)] -mosaicL _ _ _ _ [] = [] +data NamedWindow = NW !String !Window +instance Eq NamedWindow where + (NW s _) == (NW s' _) = s == s' +instance Ord NamedWindow where + compare (NW s _) (NW s' _) = compare s s' + +mosaicL :: Rational -> M.Map NamedWindow WindowRater -> M.Map NamedWindow Area + -> Rectangle -> [Window] -> X [(Window, Rectangle)] +mosaicL _ _ _ _ [] = return [] mosaicL f raters areas origRect origws - = flattenMosaic $ the_value $ if myv < myh then myv else myh + = do namedws <- mapM getName origws + let sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) namedws + myv = my_mosaic origRect Vertical sortedws + myh = my_mosaic origRect Horizontal sortedws + return $ map (\(nw,r)->(unName nw,r)) $ flattenMosaic $ the_value $ if myv < myh then myv else myh where mean_area = area origRect / fromIntegral (length origws) - myv = my_mosaic origRect Vertical sortedws - myh = my_mosaic origRect Horizontal sortedws - sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) origws - my_mosaic :: Rectangle -> CutDirection -> [Window] - -> Rated Rational (Mosaic (Window, Rectangle)) + my_mosaic :: Rectangle -> CutDirection -> [NamedWindow] + -> Rated Rational (Mosaic (NamedWindow, Rectangle)) my_mosaic _ _ [] = Rated 0 $ M [] my_mosaic r _ [w] = Rated (rating w r) $ OM (w,r) my_mosaic r d ws = minL $ @@ -184,3 +188,14 @@ allsplits (x:xs) = (map ([x]:) splitsrest) ++ maphead :: (a->a) -> [a] -> [a] maphead f (x:xs) = f x : xs maphead _ [] = [] + +getName :: Window -> X NamedWindow +getName w = asks display >>= \d -> do n <- maybe "" id `fmap` io (fetchName d w) + return $ NW n w + +unName :: NamedWindow -> Window +unName (NW _ w) = w + +withNamedWindow :: (NamedWindow -> X ()) -> X () +withNamedWindow f = do ws <- gets workspace + whenJust (W.peek ws) $ \w -> getName w >>= f -- cgit v1.2.3