diff --git a/Mosaic.hs b/Mosaic.hs index f00825ed..8b8411cf 100644 --- a/Mosaic.hs +++ b/Mosaic.hs @@ -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 diff --git a/NamedWindows.hs b/NamedWindows.hs new file mode 100644 index 00000000..71f8fe9c --- /dev/null +++ b/NamedWindows.hs @@ -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