aboutsummaryrefslogtreecommitdiffstats
path: root/Tabbed.hs
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--Tabbed.hs69
1 files changed, 49 insertions, 20 deletions
diff --git a/Tabbed.hs b/Tabbed.hs
index 9948681..28bd906 100644
--- a/Tabbed.hs
+++ b/Tabbed.hs
@@ -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]