diff options
Diffstat (limited to 'XMonad')
| -rw-r--r-- | XMonad/Layout/Tabbed.hs | 263 |
1 files changed, 80 insertions, 183 deletions
diff --git a/XMonad/Layout/Tabbed.hs b/XMonad/Layout/Tabbed.hs index db4ec05..3581793 100644 --- a/XMonad/Layout/Tabbed.hs +++ b/XMonad/Layout/Tabbed.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} + ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Tabbed @@ -11,29 +12,32 @@ -- -- A tabbed layout for the Xmonad Window Manager -- +-- This module has functions and types that conflict with those used +-- in Decoration.hs. These functions and types are deprecated and will +-- be removed. +-- +-- PLEASE: do not use 'tabbed'. Use 'tabDeco' instead. +-- ----------------------------------------------------------------------------- -module XMonad.Layout.Tabbed ( - -- * Usage: - -- $usage - tabbed - , shrinkText, CustomShrink(CustomShrink) - , TConf (..), defaultTConf - , Shrinker(..) - ) where +module XMonad.Layout.Tabbed + ( -- * Usage: + -- $usage + tabbed + , tabDeco + , TConf (..), defaultTConf + , TabbedDecoration (..), defaultTabbedConfig + , shrinkText, CustomShrink(CustomShrink) + , Shrinker(..) + ) where import Data.Maybe import Data.List import XMonad -import qualified XMonad.StackSet as W - -import XMonad.Util.NamedWindows -import XMonad.Util.Invisible -import XMonad.Util.XUtils -import XMonad.Util.Font - -import XMonad.Hooks.UrgencyHook +import qualified XMonad.StackSet as S +import XMonad.Layout.Decoration +import XMonad.Layout.Simplest -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: @@ -42,7 +46,7 @@ import XMonad.Hooks.UrgencyHook -- -- Then edit your @layoutHook@ by adding the Tabbed layout: -- --- > myLayouts = tabbed shrinkText defaultTConf ||| Full ||| etc.. +-- > myLayouts = tabDeco shrinkText defaultTabbedConfig ||| Full ||| etc.. -- > main = xmonad defaultConfig { layoutHook = myLayouts } -- -- For more detailed instructions on editing the layoutHook see: @@ -51,16 +55,56 @@ import XMonad.Hooks.UrgencyHook -- -- You can also edit the default configuration options. -- --- > myTabConfig = defaultTConf { inactiveBorderColor = "#FF0000" --- > , activeTextColor = "#00FF00"} +-- > myTabConfig = defaultTabbedConfig { inactiveBorderColor = "#FF0000" +-- > , activeTextColor = "#00FF00"} -- -- and -- --- > mylayout = tabbed shrinkText myTabConfig ||| Full ||| etc.. - -tabbed :: Shrinker s => s -> TConf -> Tabbed s a -tabbed s t = Tabbed (I Nothing) s t - +-- > mylayout = tabDeco shrinkText myTabConfig ||| Full ||| etc.. + +-- | Create a tabbed layout with a shrinker and a tabbed configuration. +tabDeco :: (Eq a, Shrinker s) => s -> DeConfig TabbedDecoration a + -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a +tabDeco s c = decoration s c Simplest + +-- | This function is deprecated and will be removed before 0.7!! +tabbed :: (Eq a, Shrinker s) => s -> TConf + -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a +tabbed s c = decoration s (toNewConf c) Simplest + +defaultTabbedConfig :: Eq a => DeConfig TabbedDecoration a +defaultTabbedConfig = mkDefaultDeConfig $ Tabbed + +data TabbedDecoration a = Tabbed deriving (Read, Show) + +instance Eq a => DecorationStyle TabbedDecoration a where + describeDeco _ = "Tabbed" + decorateFirst _ = False + pureDecoration _ _ ht (Rectangle x y wh _) s wrs (w,_) = Just $ Rectangle nx y nwh (fi ht) + where nwh = wh `div` max 1 (fi $ length wrs) + nx = case w `elemIndex` (S.integrate s) of + Just i -> x + (fi nwh * fi i) + Nothing -> x + +-- Backward compatibility stuff +-- DEPRECATED!! +toNewConf :: Eq a => TConf -> DeConfig TabbedDecoration a +toNewConf oc = + nc { XMonad.Layout.Decoration.activeColor = XMonad.Layout.Tabbed.activeColor oc + , XMonad.Layout.Decoration.inactiveColor = XMonad.Layout.Tabbed.inactiveColor oc + , XMonad.Layout.Decoration.urgentColor = XMonad.Layout.Tabbed.urgentColor oc + , XMonad.Layout.Decoration.activeBorderColor = XMonad.Layout.Tabbed.activeBorderColor oc + , XMonad.Layout.Decoration.inactiveBorderColor = XMonad.Layout.Tabbed.inactiveBorderColor oc + , XMonad.Layout.Decoration.urgentBorderColor = XMonad.Layout.Tabbed.urgentBorderColor oc + , XMonad.Layout.Decoration.activeTextColor = XMonad.Layout.Tabbed.activeTextColor oc + , XMonad.Layout.Decoration.inactiveTextColor = XMonad.Layout.Tabbed.inactiveTextColor oc + , XMonad.Layout.Decoration.urgentTextColor = XMonad.Layout.Tabbed.urgentTextColor oc + , XMonad.Layout.Decoration.fontName = XMonad.Layout.Tabbed.fontName oc + , XMonad.Layout.Decoration.decoHeight = fi $ XMonad.Layout.Tabbed.tabSize oc + } + where nc = mkDefaultDeConfig $ Tabbed + +-- | This datatype is deprecated and will be removed before 0.7!! data TConf = TConf { activeColor :: String , inactiveColor :: String @@ -75,166 +119,19 @@ data TConf = , tabSize :: Int } deriving (Show, Read) +-- | This function is deprecated and will be removed before 0.7!! defaultTConf :: TConf defaultTConf = - TConf { activeColor = "#999999" - , inactiveColor = "#666666" - , urgentColor = "#FFFF00" - , activeBorderColor = "#FFFFFF" - , inactiveBorderColor = "#BBBBBB" - , urgentBorderColor = "##00FF00" - , activeTextColor = "#FFFFFF" - , inactiveTextColor = "#BFBFBF" - , urgentTextColor = "#FF0000" - , fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - , tabSize = 20 + TConf { XMonad.Layout.Tabbed.activeColor = "#999999" + , XMonad.Layout.Tabbed.inactiveColor = "#666666" + , XMonad.Layout.Tabbed.urgentColor = "#FFFF00" + , XMonad.Layout.Tabbed.activeBorderColor = "#FFFFFF" + , XMonad.Layout.Tabbed.inactiveBorderColor = "#BBBBBB" + , XMonad.Layout.Tabbed.urgentBorderColor = "##00FF00" + , XMonad.Layout.Tabbed.activeTextColor = "#FFFFFF" + , XMonad.Layout.Tabbed.inactiveTextColor = "#BFBFBF" + , XMonad.Layout.Tabbed.urgentTextColor = "#FF0000" + , XMonad.Layout.Tabbed.fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + , XMonad.Layout.Tabbed.tabSize = 20 } -data TabState = - TabState { tabsWindows :: [(Window,Window)] - , scr :: Rectangle - , font :: XMonadFont - } - -data Tabbed s a = - Tabbed (Invisible Maybe TabState) s TConf - deriving (Show, Read) - -instance Shrinker s => LayoutClass (Tabbed s) Window where - doLayout (Tabbed ist ishr conf) = doLay ist ishr conf - handleMessage = handleMess - description _ = "Tabbed" - -doLay :: Shrinker s => Invisible Maybe TabState -> s -> TConf - -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Tabbed s 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 c 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 c 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 c sc ws - return (ts {scr = sc, tabsWindows = zip tws ws}) - mapM_ showWindow $ map fst $ tabsWindows st - mapM_ (updateTab ishr c (font st) width) $ tabsWindows st - return ([(w,shrink c sc)], Just (Tabbed (I (Just st)) ishr c)) - -handleMess :: Shrinker s => Tabbed s Window -> SomeMessage -> X (Maybe (Tabbed s 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 - releaseXMF (font st) - return $ Just $ Tabbed (I Nothing) ishr conf -handleMess _ _ = return Nothing - -handleEvent :: Shrinker s => s -> TConf -> TabState -> Event -> X () --- button press -handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = 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) - -handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs}) - (AnyEvent {ev_window = thisw, ev_event_type = t }) --- expose - | thisw `elem` (map fst tws) && t == expose = do - updateTab ishr conf fs width (thisw, fromJust $ lookup thisw tws) - where - width = rect_width screen`div` fromIntegral (length tws) - --- propertyNotify -handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = 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, font = 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 <- initXMF (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) True - io $ restackWindows d $ w : [ow] - ws <- createTabs c (Rectangle (x + fromIntegral wid) y (wh - wid) ht) ows - return (w:ws) - -updateTab :: Shrinker s => s -> TConf -> XMonadFont -> Dimension -> (Window,Window) -> X () -updateTab ishr c fs wh (tabw,ow) = do - nw <- getName ow - ur <- readUrgents - let ht = fromIntegral $ tabSize c :: Dimension - focusColor win ic ac uc = (maybe ic (\focusw -> case () of - _ | focusw == win -> ac - | win `elem` ur -> uc - | otherwise -> ic) . W.peek) - `fmap` gets windowset - (bc',borderc',tc') <- focusColor ow - (inactiveColor c, inactiveBorderColor c, inactiveTextColor c) - (activeColor c, activeBorderColor c, activeTextColor c) - (urgentColor c, urgentBorderColor c, urgentTextColor c) - dpy <- asks display - let s = shrinkIt ishr - name <- shrinkWhile s (\n -> do - size <- io $ textWidthXMF dpy fs n - return $ size > 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)) - -shrinkWhile :: (String -> [String]) -> (String -> X Bool) -> String -> X String -shrinkWhile sh p x = sw $ sh x - where sw [n] = return n - sw [] = return "" - sw (n:ns) = do - cond <- p n - if cond - then sw ns - else return n - -data CustomShrink = CustomShrink -instance Show CustomShrink where show _ = "" -instance Read CustomShrink where readsPrec _ s = [(CustomShrink,s)] - -class (Read s, Show s) => Shrinker s where - shrinkIt :: s -> String -> [String] - -data DefaultShrinker = DefaultShrinker -instance Show DefaultShrinker where show _ = "" -instance Read DefaultShrinker where readsPrec _ s = [(DefaultShrinker,s)] -instance Shrinker DefaultShrinker where - shrinkIt _ "" = [""] - shrinkIt s cs = cs : shrinkIt s (init cs) - -shrinkText :: DefaultShrinker -shrinkText = DefaultShrinker |