diff options
| -rw-r--r-- | Decoration.hs | 7 | ||||
| -rw-r--r-- | Tabbed.hs | 69 |
2 files changed, 53 insertions, 23 deletions
diff --git a/Decoration.hs b/Decoration.hs index 2543af9..8eae4d7 100644 --- a/Decoration.hs +++ b/Decoration.hs @@ -33,9 +33,10 @@ import Operations ( UnDoLayout(UnDoLayout) ) -- You can use this module for writing other extensions. -- See, for instance, "XMonadContrib.Tabbed" -newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel - -> (Display -> Window -> GC -> X ()) -> X () -> X Window -newDecoration decfor (Rectangle x y w h) th fg bg draw click = do +newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel -> String + -> (Display -> Window -> GC -> FontStruct -> X ()) + -> X () -> Layout a -> X (Layout a) +newDecoration decfor (Rectangle x y w h) th fg bg fn draw click l = do d <- asks display rt <- asks theRoot win <- io $ createSimpleWindow d rt x y w h (fromIntegral th) fg bg @@ -20,7 +20,6 @@ module XMonadContrib.Tabbed ( , TConf (..), defaultTConf ) where -import Control.Monad ( forM, liftM ) import Control.Monad.State ( gets ) import Graphics.X11.Xlib @@ -30,17 +29,17 @@ import Operations ( focus, initColor ) import qualified StackSet as W import XMonadContrib.NamedWindows +import XMonadContrib.SimpleStacking ( simpleStacking ) import XMonadContrib.LayoutHelpers ( idModify ) -- $usage -- You can use this module with the following in your configuration file: -- -- > import XMonadContrib.Tabbed --- > import XMonadContrib.SimpleStacking -- -- > defaultLayouts :: [Layout] --- > defaultLayouts = [ simpleStacking $ tabbed shrinkText defaultTConf --- > , ... ] +-- > defaultLayouts = [ tabbed shrinkText defaultTConf +-- > , ... ] -- -- You can also edit the default configuration options. -- @@ -49,26 +48,56 @@ import XMonadContrib.LayoutHelpers ( idModify ) -- -- and -- --- > defaultLayouts = [ simpleStacking $ tabbed shrinkText myconfig --- > , ... ] +-- > defaultLayouts = [ tabbed shrinkText myconfig +-- > , ... ] -tabbed :: Shrinker -> Layout Window -tabbed shrinkT = Layout { doLayout = dolay shrinkT, modifyLayout = const (return Nothing) } +data TConf = + TConf { activeColor :: String + , 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 + } -dolay :: Shrinker -> Rectangle -> W.Stack Window -> X [(Window, Rectangle)] -dolay _ sc (W.Stack w [] []) = return [(w,sc)] -dolay shr sc@(Rectangle x y wid _) s = withDisplay $ \dpy -> - do activecolor <- io $ initColor dpy "#BBBBBB" - inactivecolor <- io $ initColor dpy "#888888" - textcolor <- io $ initColor dpy "#000000" - bgcolor <- io $ initColor dpy "#000000" +tabbed :: Shrinker -> TConf -> Layout Window +tabbed s t = simpleStacking $ tabbed' s t + +tabbed' :: Shrinker -> TConf -> Layout Window +tabbed' shrinkT config = Layout { doLayout = dolay shrinkT config, modifyLayout = idModify } + +dolay :: Shrinker -> TConf + -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Layout Window)) +dolay _ _ sc (W.Stack w [] []) = return ([(w,sc)], Nothing) +dolay shr conf sc@(Rectangle x y wid _) s = withDisplay $ \dpy -> + do activecolor <- io $ initColor dpy $ activeColor conf + inactivecolor <- io $ initColor dpy $ inactiveColor conf + textcolor <- io $ initColor dpy $ textColor conf + bgcolor <- io $ initColor dpy $ bgColor conf let ws = W.integrate s ts = gentabs conf x y wid (length ws) tws = zip ts ws - maketab (t,ow) = newDecoration ow t 1 bgcolor activecolor (drawtab t ow) (focus ow) - drawtab r@(Rectangle _ _ wt ht) ow d w' gc = + make_tabs [] l = return l + make_tabs (tw':tws') l = do l' <- maketab tw' l + make_tabs tws' l' + maketab (t,ow) = newDecoration ow t 1 bgcolor activecolor + (fontName conf) (drawtab t ow) (focus ow) + drawtab r@(Rectangle _ _ wt ht) ow d w' gc fn = do nw <- getName ow - tabcolor <- (maybe inactivecolor (\focusw -> if focusw == ow then activecolor else inactivecolor) . W.peek) `liftM` gets windowset + tabcolor <- (maybe inactivecolor (\focusw -> if focusw == ow + then activecolor + else inactivecolor) . W.peek) + `fmap` gets windowset io $ setForeground d gc tabcolor io $ fillRectangles d w' gc [Rectangle 0 0 wt ht] io $ setForeground d gc textcolor @@ -81,8 +110,8 @@ dolay shr sc@(Rectangle x y wid _) s = withDisplay $ \dpy -> io $ drawString d w' gc (fromIntegral (wt `div` 2) - fromIntegral (width `div` 2)) ((fromIntegral ht + fromIntegral asc) `div` 2) name' - forM tws maketab - return $ map (\w -> (w,shrink sc)) ws + l' <- make_tabs tws $ tabbed shr conf + return (map (\w -> (w,shrink conf sc)) ws, Just l') type Shrinker = String -> [String] |