Extract NamedWindow support from Mosaic into its own module

This commit is contained in:
glasser 2007-05-23 15:58:55 +00:00
parent 20fadfe171
commit aeee485def
2 changed files with 33 additions and 21 deletions

View File

@ -26,12 +26,8 @@ module XMonadContrib.Mosaic ( mosaic, expandWindow, shrinkWindow, squareWindow,
-- , ((modMask .|. shiftMask, xK_s ), withNamedWindow (sendMessage . squareWindow))
-- , ((modMask .|. shiftMask, xK_o ), withNamedWindow (sendMessage . clearWindow))
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
@ -39,6 +35,8 @@ import Data.List ( sort )
import Data.Typeable ( Typeable )
import Control.Monad ( mplus )
import XMonadContrib.NamedWindows
import System.IO.Unsafe
data HandleWindow = ExpandWindow NamedWindow | ShrinkWindow NamedWindow
@ -91,12 +89,6 @@ add_rater r w = M.alter f w where f Nothing= Just r
type WindowRater = NamedWindow -> Rectangle -> Rational
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 []
@ -195,14 +187,3 @@ 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 windowset
whenJust (W.peek ws) $ \w -> getName w >>= f

31
NamedWindows.hs Normal file
View File

@ -0,0 +1,31 @@
module XMonadContrib.NamedWindows ( NamedWindow, getName, withNamedWindow, unName ) where
-- This module allows you to associate the X titles of windows with
-- them. See XMonadContrib.Mosaic for an example of its use.
import Control.Monad.Reader ( asks )
import Control.Monad.State ( gets )
import qualified StackSet as W ( peek )
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras ( fetchName )
import XMonad
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'
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 windowset
whenJust (W.peek ws) $ \w -> getName w >>= f