twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-08-01 12:41:52 -07:00
Code Issues Packages Projects Releases Wiki Activity

make everything work with new doLayout.

Browse Source 
This modifies all the contrib modules to work (so far as I know) with the
new contrib layout.  The exception is the LayoutHooks module, which isn't
used.  It exports an API that is inherently unsafe, so far as I can tell
(and always has been).
This commit is contained in:
David Roundy
2007-06-23 21:09:52 +00:00
parent 91a286a9fd
commit d3048ed615
13 changed files with 97 additions and 118 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
Accordion.hs
View File

@@ -31,10 +31,11 @@ import XMonadContrib.LayoutHelpers ( idModify )
accordion :: Eq a => Layout a accordion :: Eq a => Layout a
accordion = Layout { doLayout = accordionLayout, modifyLayout = idModify } accordion = Layout { doLayout = accordionLayout, modifyLayout = idModify }
accordionLayout :: Eq a => Rectangle -> W.Stack a -> X [(a, Rectangle)] accordionLayout :: Eq a => Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (Layout a))
accordionLayout sc ws = return $ (zip ups tops) ++ accordionLayout sc ws = return ((zip ups tops) ++
[(W.focus ws, mainPane)] ++ [(W.focus ws, mainPane)] ++
(zip dns bottoms) (zip dns bottoms)
,Nothing)
where ups = W.up ws where ups = W.up ws
dns = W.down ws dns = W.down ws
(top, allButTop) = splitVerticallyBy (1%8) sc (top, allButTop) = splitVerticallyBy (1%8) sc

6
Circle.hs
View File

@@ -22,14 +22,16 @@ import Graphics.X11.Xlib
import XMonad import XMonad
import StackSet (integrate, Stack(..)) import StackSet (integrate, Stack(..))
import XMonadContrib.LayoutHelpers ( idModify )
-- $usage -- $usage
-- You can use this module with the following in your Config.hs file: -- You can use this module with the following in your Config.hs file:
-- --
-- > import XMonadContrib.Circle -- > import XMonadContrib.Circle
circle :: Layout a circle :: Layout a
circle = Layout { doLayout = \r s -> return . raise (length (up s)) . circleLayout r $ integrate s, circle = Layout { doLayout = \r s -> return (raise (length (up s)) . circleLayout r $ integrate s, Nothing),
modifyLayout = return . const Nothing } modifyLayout = idModify }
circleLayout :: Rectangle -> [a] -> [(a, Rectangle)] circleLayout :: Rectangle -> [a] -> [(a, Rectangle)]
circleLayout _ [] = [] circleLayout _ [] = []

30
Combo.hs
View File

@@ -18,9 +18,9 @@ module XMonadContrib.Combo (
combo combo
) where ) where
import Data.Maybe ( isJust )
import XMonad import XMonad
import StackSet ( integrate, differentiate ) import StackSet ( integrate, differentiate )
import Operations ( UnDoLayout(UnDoLayout) )
-- $usage -- $usage
-- --
@@ -37,10 +37,11 @@ import Operations ( UnDoLayout(UnDoLayout) )
combo :: [(Layout a, Int)] -> Layout a -> Layout a combo :: [(Layout a, Int)] -> Layout a -> Layout a
combo origls super = Layout { doLayout = \r s -> arrange r (integrate s), modifyLayout = message } combo origls super = Layout { doLayout = \r s -> arrange r (integrate s), modifyLayout = message }
where arrange _ [] = return [] where arrange _ [] = return ([], Nothing)
arrange r [w] = return [(w,r)] arrange r [w] = return ([(w,r)], Nothing)
arrange rinput origws = arrange rinput origws =
do rs <- map snd `fmap` runLayout super rinput (differentiate $ take (length origls) origws) do rs <- (map snd . fst) `fmap`
runLayout super rinput (differentiate $ take (length origls) origws)
let wss [] _ = [] let wss [] _ = []
wss [_] ws = [ws] wss [_] ws = [ws]
wss (n:ns) ws = take len1 ws : wss ns (drop len1 ws) wss (n:ns) ws = take len1 ws : wss ns (drop len1 ws)
@@ -48,13 +49,16 @@ combo origls super = Layout { doLayout = \r s -> arrange r (integrate s), modify
out <- sequence $ zipWith3 runLayout (map fst origls) rs out <- sequence $ zipWith3 runLayout (map fst origls) rs
(map differentiate $ (map differentiate $
wss (take (length rs) $ map snd origls) origws) wss (take (length rs) $ map snd origls) origws)
return $ concat out let origls' = zipWith foo (out++repeat ([],Nothing)) origls
message m = case fromMessage m of foo (_, Nothing) x = x
Just UnDoLayout -> fmap (\(super':ls') -> Just $ combo (zip ls' $ map snd origls) super') foo (_, Just l') (_, n) = (l', n)
(broadcastPrivate UnDoLayout (super:map fst origls)) return (concat $ map fst out, Just $ combo origls' super)
_ -> fmap (maybe Nothing (Just . combo origls)) (modifyLayout super m) message m = do mls <- broadcastPrivate m (super:map fst origls)
return $ (\(super':ls') -> combo (zip ls' $ map snd origls) super') `fmap` mls
broadcastPrivate :: Message a => a -> [Layout b] -> X [Layout b] broadcastPrivate :: SomeMessage -> [Layout b] -> X (Maybe [Layout b])
broadcastPrivate a ol = mapM f ol broadcastPrivate a ol = do nml <- mapM f ol
where f l = do ml' <- modifyLayout l (SomeMessage a) `catchX` return (Just l) if any isJust nml
return $ maybe l id ml' then return $ Just $ zipWith ((flip maybe) id) ol nml
else return Nothing
where f l = modifyLayout l a `catchX` return Nothing

20
Decoration.hs
View File

@@ -24,7 +24,7 @@ import Control.Monad.Reader ( asks )
import Graphics.X11.Xlib import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras ( Event(AnyEvent,ButtonEvent), ev_subwindow, ev_event_type, ev_window ) import Graphics.X11.Xlib.Extras ( Event(AnyEvent,ButtonEvent), ev_subwindow, ev_event_type, ev_window )
import XMonadContrib.LayoutHooks import XMonadContrib.LayoutHelpers ( ModLay, layoutModify, idModDo )
import XMonad import XMonad
import Operations ( UnDoLayout(UnDoLayout) ) import Operations ( UnDoLayout(UnDoLayout) )
@@ -33,19 +33,19 @@ import Operations ( UnDoLayout(UnDoLayout) )
-- You can use this module for writing other extensions. -- You can use this module for writing other extensions.
-- See, for instance, "XMonadContrib.Tabbed" -- See, for instance, "XMonadContrib.Tabbed"
newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel -> String newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel
-> (Display -> Window -> GC -> FontStruct -> X ()) -> X () -> X Window -> (Display -> Window -> GC -> X ()) -> X () -> X Window
newDecoration decfor (Rectangle x y w h) th fg bg fn draw click = do newDecoration decfor (Rectangle x y w h) th fg bg draw click = do
d <- asks display d <- asks display
rt <- asks theRoot rt <- asks theRoot
win <- io $ createSimpleWindow d rt x y w h (fromIntegral th) fg bg win <- io $ createSimpleWindow d rt x y w h (fromIntegral th) fg bg
io $ selectInput d win $ exposureMask .|. buttonPressMask io $ selectInput d win $ exposureMask .|. buttonPressMask
io $ mapWindow d win io $ mapWindow d win
let hook :: SomeMessage -> X Bool let hook :: SomeMessage -> X (Maybe (ModLay a))
hook sm | Just e <- fromMessage sm = handle_event e >> return True hook sm | Just e <- fromMessage sm = handle_event e >> return Nothing
| Just UnDoLayout == fromMessage sm = io (destroyWindow d win) >> return False | Just UnDoLayout == fromMessage sm = io (destroyWindow d win) >> return (Just id)
| otherwise = return True | otherwise = return Nothing
handle_event (ButtonEvent {ev_subwindow = thisw,ev_event_type = t}) handle_event (ButtonEvent {ev_subwindow = thisw,ev_event_type = t})
| t == buttonPress && thisw == win = click | t == buttonPress && thisw == win = click
@@ -56,9 +56,7 @@ newDecoration decfor (Rectangle x y w h) th fg bg fn draw click = do
| thisw == decfor && t == propertyNotify = withGC win fn draw | thisw == decfor && t == propertyNotify = withGC win fn draw
handle_event _ = return () handle_event _ = return ()
addLayoutMessageHook hook return $ layoutModify idModDo hook l
return win
-- FIXME: withGC should use bracket (but can't, unless draw is an IO thing) -- FIXME: withGC should use bracket (but can't, unless draw is an IO thing)
withGC :: Drawable -> String -> (Display -> Drawable -> GC -> FontStruct -> X ()) -> X () withGC :: Drawable -> String -> (Display -> Drawable -> GC -> FontStruct -> X ()) -> X ()

3
HintedTile.hs
View File

@@ -44,7 +44,8 @@ tall = tile splitHorizontally divideVertically
tile split divide nmaster delta frac = tile split divide nmaster delta frac =
Layout { doLayout = \r w' -> let w = W.integrate w' Layout { doLayout = \r w' -> let w = W.integrate w'
in do { hints <- sequence (map getHints w) in do { hints <- sequence (map getHints w)
; return $ zip w (tiler frac r `uncurry` splitAt nmaster hints) } ; return (zip w (tiler frac r `uncurry` splitAt nmaster hints)
, Nothing) }
, modifyLayout = \m -> return $ fmap resize (fromMessage m) `mplus` , modifyLayout = \m -> return $ fmap resize (fromMessage m) `mplus`
fmap incmastern (fromMessage m) } fmap incmastern (fromMessage m) }

25
LayoutHelpers.hs
View File

@@ -17,7 +17,7 @@ module XMonadContrib.LayoutHelpers (
DoLayout, ModDo, ModMod, ModLay, DoLayout, ModDo, ModMod, ModLay,
layoutModify, layoutModify,
l2lModDo, idModify, l2lModDo, idModify,
idModMod, idModDo, idModMod,
) where ) where
import Graphics.X11.Xlib ( Rectangle ) import Graphics.X11.Xlib ( Rectangle )
@@ -27,8 +27,7 @@ import StackSet ( Stack, integrate )
-- $usage -- $usage
-- Use LayoutHelpers to help write easy Layouts. -- Use LayoutHelpers to help write easy Layouts.
--type DoLayout a = Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (Layout a)) type DoLayout a = Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (Layout a))
type DoLayout a = Rectangle -> Stack a -> X [(a, Rectangle)]
type ModifyLayout a = SomeMessage -> X (Maybe (Layout a)) type ModifyLayout a = SomeMessage -> X (Maybe (Layout a))
type ModDo a = Rectangle -> Stack a -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ModLay a)) type ModDo a = Rectangle -> Stack a -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ModLay a))
@@ -38,16 +37,12 @@ type ModLay a = Layout a -> Layout a
layoutModify :: ModDo a -> ModMod a -> ModLay a layoutModify :: ModDo a -> ModMod a -> ModLay a
layoutModify fdo fmod l = Layout { doLayout = dl, modifyLayout = modl } layoutModify fdo fmod l = Layout { doLayout = dl, modifyLayout = modl }
where dl r s = do --(ws, ml') <- doLayout l r s where dl r s = do (ws, ml') <- doLayout l r s
ws <- doLayout l r s
(ws', mmod') <- fdo r s ws (ws', mmod') <- fdo r s ws
--let ml'' = case mmod' of let ml'' = case mmod' of
-- Just mod' -> Just $ mod' $ maybe l id ml' Just mod' -> Just $ mod' $ maybe l id ml'
-- Nothing -> layoutModify fdo mod `fmap` ml' Nothing -> layoutModify fdo fmod `fmap` ml'
--return (ws', ml'') return (ws', ml'')
case mmod' of
Just _ -> fail "Sorry, can't yet safely modify layouts in doLayout."
Nothing -> return ws'
modl m = do ml' <- modifyLayout l m modl m = do ml' <- modifyLayout l m
mmod' <- fmod m mmod' <- fmod m
return $ case mmod' of return $ case mmod' of
@@ -55,8 +50,10 @@ layoutModify fdo fmod l = Layout { doLayout = dl, modifyLayout = modl }
Nothing -> layoutModify fdo fmod `fmap` ml' Nothing -> layoutModify fdo fmod `fmap` ml'
l2lModDo :: (Rectangle -> [a] -> [(a,Rectangle)]) -> DoLayout a l2lModDo :: (Rectangle -> [a] -> [(a,Rectangle)]) -> DoLayout a
--l2lModDo dl r s = return (dl r $ integrate s, Nothing) l2lModDo dl r s = return (dl r $ integrate s, Nothing)
l2lModDo dl r s = return (dl r $ integrate s)
idModDo :: ModDo a
idModDo _ _ wrs = return (wrs, Nothing)
idModify :: ModifyLayout a idModify :: ModifyLayout a
idModify _ = return Nothing idModify _ = return Nothing

11
LayoutHints.hs
View File

@@ -21,6 +21,7 @@ import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras ( getWMNormalHints ) import Graphics.X11.Xlib.Extras ( getWMNormalHints )
import {-#SOURCE#-} Config (borderWidth) import {-#SOURCE#-} Config (borderWidth)
import XMonad hiding ( trace ) import XMonad hiding ( trace )
import XMonadContrib.LayoutHelpers ( layoutModify, idModMod )
-- $usage -- $usage
-- > import XMonadContrib.LayoutHints -- > import XMonadContrib.LayoutHints
@@ -32,12 +33,10 @@ adjBorders :: Dimension -> D -> D
adjBorders mult (w,h) = (w+2*mult*borderWidth, h+2*mult*borderWidth) adjBorders mult (w,h) = (w+2*mult*borderWidth, h+2*mult*borderWidth)
layoutHints :: Layout Window -> Layout Window layoutHints :: Layout Window -> Layout Window
layoutHints l = l { doLayout = \r x -> doLayout l r x >>= applyHints layoutHints = layoutModify applyHints idModMod
, modifyLayout = \x -> fmap layoutHints `fmap` modifyLayout l x } where applyHints _ _ xs = do xs' <- mapM applyHint xs
return (xs', Nothing)
applyHints :: [(Window, Rectangle)] -> X [(Window, Rectangle)] applyHint (w,Rectangle a b c d) =
applyHints xs = mapM applyHint xs
where applyHint (w,Rectangle a b c d) =
withDisplay $ \disp -> withDisplay $ \disp ->
do sh <- io $ getWMNormalHints disp w do sh <- io $ getWMNormalHints disp w
let (c',d') = adjBorders 1 . applySizeHints sh . adjBorders (-1) $ (c,d) let (c',d') = adjBorders 1 . applySizeHints sh . adjBorders (-1) $ (c,d)

2
LayoutScreens.hs
View File

@@ -48,7 +48,7 @@ layoutScreens :: Int -> Layout Int -> X ()
layoutScreens nscr _ | nscr < 1 = trace $ "Can't layoutScreens with only " ++ show nscr ++ " screens." layoutScreens nscr _ | nscr < 1 = trace $ "Can't layoutScreens with only " ++ show nscr ++ " screens."
layoutScreens nscr l = layoutScreens nscr l =
do rtrect <- asks theRoot >>= getWindowRectangle do rtrect <- asks theRoot >>= getWindowRectangle
wss <- doLayout l rtrect W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] } (wss, _) <- doLayout l rtrect W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] }
modify $ \s -> s { xineScreens = map snd wss modify $ \s -> s { xineScreens = map snd wss
, statusGaps = take nscr $ (statusGaps s) ++ repeat (0,0,0,0) } , statusGaps = take nscr $ (statusGaps s) ++ repeat (0,0,0,0) }

23
Magnifier.hs
View File

@@ -24,6 +24,7 @@ module XMonadContrib.Magnifier (
import Graphics.X11.Xlib import Graphics.X11.Xlib
import XMonad import XMonad
import StackSet import StackSet
import XMonadContrib.LayoutHelpers
-- $usage -- $usage
-- > import XMonadContrib.Magnifier -- > import XMonadContrib.Magnifier
@@ -31,24 +32,20 @@ import StackSet
-- | Increase the size of the window that has focus, unless it is the master window. -- | Increase the size of the window that has focus, unless it is the master window.
magnifier :: Eq a => Layout a -> Layout a magnifier :: Eq a => Layout a -> Layout a
magnifier l = l { doLayout = \r s -> unlessMaster applyMagnifier r s `fmap` doLayout l r s magnifier = layoutModify (unlessMaster applyMagnifier) idModMod
, modifyLayout = \x -> fmap magnifier `fmap` modifyLayout l x }
-- | Increase the size of the window that has focus, even if it is the master window. -- | Increase the size of the window that has focus, even if it is the master window.
magnifier' :: Eq a => Layout a -> Layout a magnifier' :: Eq a => Layout a -> Layout a
magnifier' l = l { doLayout = \r s -> applyMagnifier r s `fmap` doLayout l r s magnifier' = layoutModify applyMagnifier idModMod
, modifyLayout = \x -> fmap magnifier' `fmap` modifyLayout l x }
unlessMaster :: ModDo a -> ModDo a
unlessMaster mainmod r s wrs = if null (up s) then return (wrs, Nothing)
else mainmod r s wrs
type DoLayout = Eq a => Rectangle -> Stack a -> [(a, Rectangle)] -> [(a, Rectangle)] applyMagnifier :: Eq a => ModDo a
applyMagnifier r s wrs = return (map mag wrs, Nothing)
unlessMaster :: DoLayout -> DoLayout where mag (w,wr) | w == focus s = (w, shrink r $ magnify wr)
unlessMaster f r s = if null (up s) then id else f r s | otherwise = (w,wr)
applyMagnifier :: DoLayout
applyMagnifier r s = reverse . foldr accumulate []
where accumulate (w,wr) ws | w == focus s = ws ++ [(w, shrink r $ magnify wr)]
| otherwise = (w,wr) : ws
magnify :: Rectangle -> Rectangle magnify :: Rectangle -> Rectangle
magnify (Rectangle x y w h) = Rectangle x' y' w' h' magnify (Rectangle x y w h) = Rectangle x' y' w' h'

11
Mosaic.hs
View File

@@ -87,7 +87,8 @@ flexibility :: Double
flexibility = 0.1 flexibility = 0.1
mosaic :: Double -> Double -> M.Map NamedWindow [WindowHint] -> Layout Window mosaic :: Double -> Double -> M.Map NamedWindow [WindowHint] -> Layout Window
mosaic delta tileFrac hints = full { doLayout = \r -> mosaicL tileFrac hints r . W.integrate, modifyLayout = return . mlayout } mosaic delta tileFrac hints = full { doLayout = \r -> mosaicL tileFrac hints r . W.integrate
, modifyLayout = return . mlayout }
where mlayout x = (m1 `fmap` fromMessage x) `mplus` (m2 `fmap` fromMessage x) where mlayout x = (m1 `fmap` fromMessage x) `mplus` (m2 `fmap` fromMessage x)
m1 Shrink = mosaic delta (tileFrac/(1+delta)) hints m1 Shrink = mosaic delta (tileFrac/(1+delta)) hints
m1 Expand = mosaic delta (tileFrac*(1+delta)) hints m1 Expand = mosaic delta (tileFrac*(1+delta)) hints
@@ -136,8 +137,8 @@ alterlist f k = M.alter f' k
xs' -> Just xs' xs' -> Just xs'
mosaicL :: Double -> M.Map NamedWindow [WindowHint] mosaicL :: Double -> M.Map NamedWindow [WindowHint]
-> Rectangle -> [Window] -> X [(Window, Rectangle)] -> Rectangle -> [Window] -> X ([(Window, Rectangle)],Maybe (Layout Window))
mosaicL _ _ _ [] = return [] mosaicL _ _ _ [] = return ([], Nothing)
mosaicL f hints origRect origws mosaicL f hints origRect origws
= do namedws <- mapM getName origws = do namedws <- mapM getName origws
let sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) namedws let sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) namedws
@@ -152,13 +153,13 @@ mosaicL f hints origRect origws
-- myh2 = maxL $ runCountDown largeNumber $ -- myh2 = maxL $ runCountDown largeNumber $
-- sequence $ replicate mediumNumber $ -- sequence $ replicate mediumNumber $
-- mosaic_splits one_split origRect Horizontal sortedws -- mosaic_splits one_split origRect Horizontal sortedws
return $ map (\(nw,r)->(--trace ("rate1:"++ unlines [show nw, return (map (\(nw,r)->(--trace ("rate1:"++ unlines [show nw,
-- show $ rate f meanarea (findlist nw hints) r, -- show $ rate f meanarea (findlist nw hints) r,
-- show r, -- show r,
-- show $ area r/meanarea, -- show $ area r/meanarea,
-- show $ findlist nw hints]) $ -- show $ findlist nw hints]) $
unName nw,crop' (findlist nw hints) r)) $ unName nw,crop' (findlist nw hints) r)) $
flattenMosaic $ the_value $ maxL [myh,myv,myh2,myv2] flattenMosaic $ the_value $ maxL [myh,myv,myh2,myv2], Nothing)
where mosaic_splits _ _ _ [] = return $ Rated 0 $ M [] where mosaic_splits _ _ _ [] = return $ Rated 0 $ M []
mosaic_splits _ r _ [w] = return $ Rated (rate f meanarea (findlist w hints) r) $ OM (w,r) mosaic_splits _ r _ [w] = return $ Rated (rate f meanarea (findlist w hints) r) $ OM (w,r)
mosaic_splits spl r d ws = maxL `fmap` mapCD (spl r d) (init $ allsplits ws) mosaic_splits spl r d ws = maxL `fmap` mapCD (spl r d) (init $ allsplits ws)

24
SimpleStacking.hs
View File

@@ -21,15 +21,16 @@ module XMonadContrib.SimpleStacking (
simpleStacking simpleStacking
) where ) where
import Control.Monad.State ( modify ) import Control.Monad.State ( get )
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe ( catMaybes ) import Data.Maybe ( catMaybes )
import Data.List ( nub, lookup ) import Data.List ( nub, lookup, delete )
import StackSet ( focus, tag, workspace, current, integrate ) import StackSet ( focus, tag, workspace, current, up, down )
import Graphics.X11.Xlib ( Window ) import Graphics.X11.Xlib ( Window )
import XMonad import XMonad
import XMonadContrib.LayoutHelpers
-- $usage -- $usage
-- You can use this module for -- You can use this module for
@@ -39,14 +40,9 @@ simpleStacking :: Layout Window -> Layout Window
simpleStacking = simpleStacking' [] simpleStacking = simpleStacking' []
simpleStacking' :: [Window] -> Layout Window -> Layout Window simpleStacking' :: [Window] -> Layout Window -> Layout Window
simpleStacking' st l = l { doLayout = dl simpleStacking' st = layoutModify dl idModMod
, modifyLayout = \m -> fmap (simpleStacking' st) `fmap` modifyLayout l m } where dl r s wrs = let m = map (\ (w,rr) -> (w,(w,rr))) wrs
where dl r s = do modify $ \ state -> wrs' = catMaybes $ map ((flip lookup) m) $
state { layouts = M.adjust nub (focus s : st ++ map fst wrs)
(\(_,ss)->(simpleStacking' st' = focus s:filter (`elem` (up s++down s)) st
(focus s:filter (`elem` integrate s) st) l,ss)) in return (wrs', Just (simpleStacking' st'))
(tag.workspace.current.windowset $ state)
(layouts state) }
lo <- doLayout l r s
let m = map (\ (w,rr) -> (w,(w,rr))) lo
return $ catMaybes $ map ((flip lookup) m) $ nub (focus s : st ++ map fst lo)

49
Tabbed.hs
View File

@@ -20,7 +20,8 @@ module XMonadContrib.Tabbed (
, TConf (..), defaultTConf , TConf (..), defaultTConf
) where ) where
import Control.Monad ( forM ) import Control.Monad ( forM, liftM )
import Control.Monad.State ( gets )
import Graphics.X11.Xlib import Graphics.X11.Xlib
import XMonad import XMonad
@@ -29,6 +30,7 @@ import Operations ( focus, initColor )
import qualified StackSet as W import qualified StackSet as W
import XMonadContrib.NamedWindows import XMonadContrib.NamedWindows
import XMonadContrib.LayoutHelpers ( idModify )
-- $usage -- $usage
-- You can use this module with the following in your configuration file: -- You can use this module with the following in your configuration file:
@@ -50,42 +52,23 @@ import XMonadContrib.NamedWindows
-- > defaultLayouts = [ simpleStacking $ tabbed shrinkText myconfig -- > defaultLayouts = [ simpleStacking $ tabbed shrinkText myconfig
-- > , ... ] -- > , ... ]
data TConf = tabbed :: Shrinker -> Layout Window
TConf { activeColor :: String tabbed shrinkT = Layout { doLayout = dolay shrinkT, modifyLayout = const (return Nothing) }
, inactiveColor :: String
, bgColor :: String
, textColor :: String
, fontName :: String
, tabSize :: Int
} deriving (Show, Read)
defaultTConf :: TConf
defaultTConf =
TConf { activeColor ="#BBBBBB"
, inactiveColor = "#888888"
, bgColor = "#000000"
, textColor = "#000000"
, fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
, tabSize = 20
}
tabbed :: Shrinker -> TConf -> Layout Window dolay :: Shrinker -> Rectangle -> W.Stack Window -> X [(Window, Rectangle)]
tabbed shrinkT config = Layout { doLayout = dolay shrinkT config, modifyLayout = const (return Nothing) } dolay _ sc (W.Stack w [] []) = return [(w,sc)]
dolay shr sc@(Rectangle x y wid _) s = withDisplay $ \dpy ->
dolay :: Shrinker -> TConf -> Rectangle -> W.Stack Window -> X [(Window, Rectangle)] do activecolor <- io $ initColor dpy "#BBBBBB"
dolay _ _ sc (W.Stack w [] []) = return [(w,sc)] inactivecolor <- io $ initColor dpy "#888888"
dolay shr conf sc@(Rectangle x y wid _) s = withDisplay $ \dpy -> textcolor <- io $ initColor dpy "#000000"
do activecolor <- io $ initColor dpy $ activeColor conf bgcolor <- io $ initColor dpy "#000000"
inactivecolor <- io $ initColor dpy $ inactiveColor conf
textcolor <- io $ initColor dpy $ textColor conf
bgcolor <- io $ initColor dpy $ bgColor conf
let ws = W.integrate s let ws = W.integrate s
ts = gentabs conf x y wid (length ws) ts = gentabs conf x y wid (length ws)
tws = zip ts ws tws = zip ts ws
maketab (t,ow) = newDecoration ow t 1 bgcolor activecolor (fontName conf) (drawtab t ow) (focus ow) maketab (t,ow) = newDecoration ow t 1 bgcolor activecolor (drawtab t ow) (focus ow)
drawtab r@(Rectangle _ _ wt ht) ow d w' gc fn = drawtab r@(Rectangle _ _ wt ht) ow d w' gc =
do nw <- getName ow do nw <- getName ow
let tabcolor = if W.focus s == ow then activecolor else inactivecolor tabcolor <- (maybe inactivecolor (\focusw -> if focusw == ow then activecolor else inactivecolor) . W.peek) `liftM` gets windowset
io $ setForeground d gc tabcolor io $ setForeground d gc tabcolor
io $ fillRectangles d w' gc [Rectangle 0 0 wt ht] io $ fillRectangles d w' gc [Rectangle 0 0 wt ht]
io $ setForeground d gc textcolor io $ setForeground d gc textcolor
@@ -99,7 +82,7 @@ dolay shr conf sc@(Rectangle x y wid _) s = withDisplay $ \dpy ->
(fromIntegral (wt `div` 2) - fromIntegral (width `div` 2)) (fromIntegral (wt `div` 2) - fromIntegral (width `div` 2))
((fromIntegral ht + fromIntegral asc) `div` 2) name' ((fromIntegral ht + fromIntegral asc) `div` 2) name'
forM tws maketab forM tws maketab
return [(W.focus s, shrink conf sc)] return $ map (\w -> (w,shrink sc)) ws
type Shrinker = String -> [String] type Shrinker = String -> [String]

2
TwoPane.hs
View File

@@ -35,7 +35,7 @@ import StackSet ( focus, up, down)
-- > twoPane defaultDelta (1%2) -- > twoPane defaultDelta (1%2)
twoPane :: Rational -> Rational -> Layout a twoPane :: Rational -> Rational -> Layout a
twoPane delta split = Layout { doLayout = \r s -> return $ arrange r s, modifyLayout = message } twoPane delta split = Layout { doLayout = \r s -> return (arrange r s,Nothing), modifyLayout = message }
where where
arrange rect st = case reverse (up st) of arrange rect st = case reverse (up st) of
(master:_) -> [(master,left),(focus st,right)] (master:_) -> [(master,left),(focus st,right)]