aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Layout/Tabbed.hs
diff options
context:
space:
mode:
Diffstat (limited to 'XMonad/Layout/Tabbed.hs')
-rw-r--r--XMonad/Layout/Tabbed.hs214
1 files changed, 214 insertions, 0 deletions
diff --git a/XMonad/Layout/Tabbed.hs b/XMonad/Layout/Tabbed.hs
new file mode 100644
index 0000000..92ef150
--- /dev/null
+++ b/XMonad/Layout/Tabbed.hs
@@ -0,0 +1,214 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : XMonad.Layout.Tabbed
+-- Copyright : (c) 2007 David Roundy, Andrea Rossato
+-- License : BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer : droundy@darcs.net, andrea.rossato@unibz.it
+-- Stability : unstable
+-- Portability : unportable
+--
+-- A tabbed layout for the Xmonad Window Manager
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Tabbed (
+ -- * Usage:
+ -- $usage
+ tabbed
+ , shrinkText
+ , TConf (..), defaultTConf
+ ) where
+
+import Control.Monad.State ( gets )
+import Control.Monad.Reader
+import Data.Maybe
+import Data.Bits
+import Data.List
+
+import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
+
+import XMonad
+import XMonad.Operations
+import qualified XMonad.StackSet as W
+
+import XMonad.Util.NamedWindows
+import XMonad.Util.Invisible
+import XMonad.Util.XUtils
+
+-- $usage
+-- You can use this module with the following in your configuration file:
+--
+-- > import XMonad.Layout.Tabbed
+--
+-- > layouts :: [Layout Window]
+-- > layouts = [ Layout tiled
+-- > , Layout $ Mirror tiled
+-- > , Layout Full
+-- >
+-- > -- Extension-provided layouts
+-- > , Layout $ tabbed shrinkText defaultTConf
+-- > ]
+-- >
+-- > , ... ]
+--
+-- You can also edit the default configuration options.
+--
+-- > myTabConfig = defaultTConf { inactiveBorderColor = "#FF0000"
+-- > , activeTextColor = "#00FF00"}
+--
+-- and
+--
+-- > layouts = [ ...
+-- > , Layout $ tabbed shrinkText myTabConfig ]
+
+-- %import XMonad.Layout.Tabbed
+-- %layout , tabbed shrinkText defaultTConf
+
+tabbed :: Shrinker -> TConf -> Tabbed a
+tabbed s t = Tabbed (I Nothing) (I (Just s)) t
+
+data TConf =
+ TConf { activeColor :: String
+ , inactiveColor :: String
+ , activeBorderColor :: String
+ , inactiveTextColor :: String
+ , inactiveBorderColor :: String
+ , activeTextColor :: String
+ , fontName :: String
+ , tabSize :: Int
+ } deriving (Show, Read)
+
+defaultTConf :: TConf
+defaultTConf =
+ TConf { activeColor = "#999999"
+ , inactiveColor = "#666666"
+ , activeBorderColor = "#FFFFFF"
+ , inactiveBorderColor = "#BBBBBB"
+ , activeTextColor = "#FFFFFF"
+ , inactiveTextColor = "#BFBFBF"
+ , fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
+ , tabSize = 20
+ }
+
+data TabState =
+ TabState { tabsWindows :: [(Window,Window)]
+ , scr :: Rectangle
+ , fontS :: FontStruct -- FontSet
+ }
+
+data Tabbed a =
+ Tabbed (Invisible Maybe TabState) (Invisible Maybe Shrinker) TConf
+ deriving (Show, Read)
+
+instance LayoutClass Tabbed Window where
+ doLayout (Tabbed ist ishr conf) = doLay ist ishr conf
+ handleMessage = handleMess
+ description _ = "Tabbed"
+
+doLay :: Invisible Maybe TabState -> Invisible Maybe Shrinker -> TConf
+ -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Tabbed Window))
+doLay ist ishr c sc (W.Stack w [] []) = do
+ whenIJust ist $ \st -> mapM_ deleteWindow (map fst $ tabsWindows st)
+ return ([(w,sc)], Just $ Tabbed (I Nothing) ishr c)
+doLay ist ishr conf sc@(Rectangle _ _ wid _) s@(W.Stack w _ _) = do
+ let ws = W.integrate s
+ width = wid `div` fromIntegral (length ws)
+ -- initialize state
+ st <- case ist of
+ (I Nothing ) -> initState conf sc ws
+ (I (Just ts)) -> if map snd (tabsWindows ts) == ws && scr ts == sc
+ then return ts
+ else do mapM_ deleteWindow (map fst $ tabsWindows ts)
+ tws <- createTabs conf sc ws
+ return (ts {scr = sc, tabsWindows = zip tws ws})
+ mapM_ showWindow $ map fst $ tabsWindows st
+ mapM_ (updateTab ishr conf (fontS st) width) $ tabsWindows st
+ return ([(w,shrink conf sc)], Just (Tabbed (I (Just st)) ishr conf))
+
+handleMess :: Tabbed Window -> SomeMessage -> X (Maybe (Tabbed Window))
+handleMess (Tabbed (I (Just st@(TabState {tabsWindows = tws}))) ishr conf) m
+ | Just e <- fromMessage m :: Maybe Event = handleEvent ishr conf st e >> return Nothing
+ | Just Hide == fromMessage m = mapM_ hideWindow (map fst tws) >> return Nothing
+ | Just ReleaseResources == fromMessage m = do mapM_ deleteWindow $ map fst tws
+ releaseFont (fontS st)
+ return $ Just $ Tabbed (I Nothing) (I Nothing) conf
+handleMess _ _ = return Nothing
+
+handleEvent :: Invisible Maybe Shrinker -> TConf -> TabState -> Event -> X ()
+-- button press
+handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, fontS = fs })
+ (ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t })
+ | t == buttonPress, tl <- map fst tws, thisw `elem` tl || thisbw `elem` tl = do
+ case lookup thisw tws of
+ Just x -> do focus x
+ updateTab ishr conf fs width (thisw, x)
+ Nothing -> return ()
+ where width = rect_width screen `div` fromIntegral (length tws)
+-- propertyNotify
+handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, fontS = fs })
+ (PropertyEvent {ev_window = thisw })
+ | thisw `elem` (map snd tws) = do
+ let tabwin = (fst $ fromJust $ find ((== thisw) . snd) tws, thisw)
+ updateTab ishr conf fs width tabwin
+ where width = rect_width screen `div` fromIntegral (length tws)
+-- expose
+handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, fontS = fs })
+ (ExposeEvent {ev_window = thisw })
+ | thisw `elem` (map fst tws) = do
+ updateTab ishr conf fs width (thisw, fromJust $ lookup thisw tws)
+ where width = rect_width screen `div` fromIntegral (length tws)
+handleEvent _ _ _ _ = return ()
+
+initState :: TConf -> Rectangle -> [Window] -> X TabState
+initState conf sc ws = do
+ fs <- initFont (fontName conf)
+ tws <- createTabs conf sc ws
+ return $ TabState (zip tws ws) sc fs
+
+createTabs :: TConf -> Rectangle -> [Window] -> X [Window]
+createTabs _ _ [] = return []
+createTabs c (Rectangle x y wh ht) owl@(ow:ows) = do
+ let wid = wh `div` (fromIntegral $ length owl)
+ height = fromIntegral $ tabSize c
+ mask = Just (exposureMask .|. buttonPressMask)
+ d <- asks display
+ w <- createNewWindow (Rectangle x y wid height) mask (inactiveColor c)
+ io $ restackWindows d $ w : [ow]
+ ws <- createTabs c (Rectangle (x + fromIntegral wid) y (wh - wid) ht) ows
+ return (w:ws)
+
+updateTab :: Invisible Maybe Shrinker -> TConf -> FontStruct -> Dimension -> (Window,Window) -> X ()
+updateTab ishr c fs wh (tabw,ow) = do
+ nw <- getName ow
+ let ht = fromIntegral $ tabSize c :: Dimension
+ focusColor win ic ac = (maybe ic (\focusw -> if focusw == win
+ then ac else ic) . W.peek)
+ `fmap` gets windowset
+ (bc',borderc',tc') <- focusColor ow
+ (inactiveColor c, inactiveBorderColor c, inactiveTextColor c)
+ (activeColor c, activeBorderColor c, activeTextColor c)
+ let s = fromIMaybe shrinkText ishr
+ name = shrinkWhile s (\n -> textWidth fs n >
+ fromIntegral wh - fromIntegral (ht `div` 2)) (show nw)
+ paintAndWrite tabw fs wh ht 1 bc' borderc' tc' bc' AlignCenter name
+
+shrink :: TConf -> Rectangle -> Rectangle
+shrink c (Rectangle x y w h) =
+ Rectangle x (y + fromIntegral (tabSize c)) w (h - fromIntegral (tabSize c))
+
+type Shrinker = String -> [String]
+
+shrinkWhile :: Shrinker -> (String -> Bool) -> String -> String
+shrinkWhile sh p x = sw $ sh x
+ where sw [n] = n
+ sw [] = ""
+ sw (n:ns) | p n = sw ns
+ | otherwise = n
+
+shrinkText :: Shrinker
+shrinkText "" = [""]
+shrinkText cs = cs : shrinkText (init cs)
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-28 06:26:58 +0000