mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-08-06 23:11:54 -07:00
make NewTabbed use InvisibleMaybe to hide its cache.
This commit is contained in:
41
NewTabbed.hs
41
NewTabbed.hs
@@ -16,7 +16,7 @@
|
|||||||
module XMonadContrib.NewTabbed (
|
module XMonadContrib.NewTabbed (
|
||||||
-- * Usage:
|
-- * Usage:
|
||||||
-- $usage
|
-- $usage
|
||||||
Tabbed (..)
|
tabbed
|
||||||
, TConf (..), defaultTConf
|
, TConf (..), defaultTConf
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@@ -45,7 +45,7 @@ import XMonadContrib.XPrompt (fillDrawable, printString)
|
|||||||
-- > defaultLayouts = [("tall", SomeLayout tiled)
|
-- > defaultLayouts = [("tall", SomeLayout tiled)
|
||||||
-- > ,("wide", SomeLayout $ Mirror tiled)
|
-- > ,("wide", SomeLayout $ Mirror tiled)
|
||||||
-- > -- Extension-provided layouts
|
-- > -- Extension-provided layouts
|
||||||
-- > ,("tabbed", SomeLayout $ Tabbed Nothing myTabConfig)
|
-- > ,("tabbed", SomeLayout $ tabbed myTabConfig)
|
||||||
-- > , ... ]
|
-- > , ... ]
|
||||||
--
|
--
|
||||||
-- You can also edit the default configuration options.
|
-- You can also edit the default configuration options.
|
||||||
@@ -61,6 +61,9 @@ import XMonadContrib.XPrompt (fillDrawable, printString)
|
|||||||
-- %import XMonadContrib.NewTabbed
|
-- %import XMonadContrib.NewTabbed
|
||||||
-- %layout , tabbed shrinkText defaultTConf
|
-- %layout , tabbed shrinkText defaultTConf
|
||||||
|
|
||||||
|
tabbed :: TConf -> Tabbed a
|
||||||
|
tabbed t = Tabbed INothin t
|
||||||
|
|
||||||
data TConf =
|
data TConf =
|
||||||
TConf { activeColor :: String
|
TConf { activeColor :: String
|
||||||
, inactiveColor :: String
|
, inactiveColor :: String
|
||||||
@@ -88,22 +91,26 @@ data TabState =
|
|||||||
TabState { tabsWindows :: [(Window,Window)]
|
TabState { tabsWindows :: [(Window,Window)]
|
||||||
, scr :: Rectangle
|
, scr :: Rectangle
|
||||||
, fontS :: FontStruct -- FontSet
|
, fontS :: FontStruct -- FontSet
|
||||||
} deriving (Read, Show)
|
}
|
||||||
|
|
||||||
data Tabbed a =
|
data Tabbed a =
|
||||||
Tabbed (Maybe TabState) TConf
|
Tabbed (InvisibleMaybe TabState) TConf
|
||||||
deriving (Show, Read)
|
deriving (Show, Read)
|
||||||
|
|
||||||
|
data InvisibleMaybe a = INothin | IJus a
|
||||||
|
instance Show (InvisibleMaybe a) where show _ = ""
|
||||||
|
instance Read (InvisibleMaybe a) where readsPrec _ s = [(INothin, s)]
|
||||||
|
whenIJus :: Monad m => InvisibleMaybe a -> (a -> m ()) -> m ()
|
||||||
|
whenIJus (IJus a) j = j a
|
||||||
|
whenIJus INothin _ = return ()
|
||||||
|
|
||||||
instance Layout Tabbed Window where
|
instance Layout Tabbed Window where
|
||||||
doLayout (Tabbed mst conf) = doLay mst conf
|
doLayout (Tabbed mst conf) = doLay mst conf
|
||||||
handleMessage l m = modLay l m
|
handleMessage l m = modLay l m
|
||||||
|
|
||||||
instance Read FontStruct where
|
doLay :: InvisibleMaybe TabState -> TConf -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Tabbed Window))
|
||||||
readsPrec _ _ = []
|
|
||||||
|
|
||||||
doLay :: Maybe TabState -> TConf -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Tabbed Window))
|
|
||||||
doLay mst _ sc (W.Stack w [] []) = do
|
doLay mst _ sc (W.Stack w [] []) = do
|
||||||
when (isJust mst) $ destroyTabs (map fst $ tabsWindows (fromJust mst))
|
whenIJus mst $ \st -> destroyTabs (map fst $ tabsWindows st)
|
||||||
return ([(w,sc)], Nothing)
|
return ([(w,sc)], Nothing)
|
||||||
doLay mst conf sc@(Rectangle _ _ wid _) s@(W.Stack w _ _) = do
|
doLay mst conf sc@(Rectangle _ _ wid _) s@(W.Stack w _ _) = do
|
||||||
let ws = W.integrate s
|
let ws = W.integrate s
|
||||||
@@ -111,28 +118,28 @@ doLay mst conf sc@(Rectangle _ _ wid _) s@(W.Stack w _ _) = do
|
|||||||
-- initialize state
|
-- initialize state
|
||||||
st <- case mst of
|
st <- case mst of
|
||||||
Nothing -> initState conf sc ws
|
Nothing -> initState conf sc ws
|
||||||
Just ts -> if map snd (tabsWindows ts) == ws && scr ts == sc
|
Just ts -> if map snd (tabsWindows ts) == ws
|
||||||
then return ts
|
then return ts
|
||||||
else do destroyTabs (map fst $ tabsWindows ts)
|
else do destroyTabs (map fst $ tabsWindows ts)
|
||||||
tws <- createTabs conf sc ws
|
tws <- createTabs conf sc ws
|
||||||
return (ts {scr = sc, tabsWindows = zip tws ws})
|
return (ts {scr = sc, tabsWindows = zip tws ws})
|
||||||
showTabs $ map fst $ tabsWindows st
|
showTabs $ map fst $ tabsWindows st
|
||||||
mapM_ (updateTab conf (fontS st) width) $ tabsWindows st
|
mapM_ (updateTab conf (fontS st) width) $ tabsWindows st
|
||||||
return ([(w,shrink conf sc)], Just (Tabbed (Just st) conf))
|
return ([(w,shrink conf sc)], Just (Tabbed (IJus st) conf))
|
||||||
|
|
||||||
modLay :: Tabbed Window -> SomeMessage -> X (Maybe (Tabbed Window))
|
modLay :: Tabbed Window -> SomeMessage -> X (Maybe (Tabbed Window))
|
||||||
modLay (Tabbed mst conf) m
|
modLay (Tabbed (IJus st) conf) m
|
||||||
| Just st <- mst, Just e <- fromMessage m :: Maybe Event = do
|
| Just e <- fromMessage m :: Maybe Event = do
|
||||||
handleEvent conf st e >> return Nothing
|
handleEvent conf st e >> return Nothing
|
||||||
| Just st <- mst, Just Hide == fromMessage m = do
|
| Just Hide == fromMessage m = do
|
||||||
hideTabs $ map fst $ tabsWindows st
|
hideTabs $ map fst $ tabsWindows st
|
||||||
return Nothing
|
return Nothing
|
||||||
| Just st <- mst, Just ReleaseResources == fromMessage m = do
|
| Just ReleaseResources == fromMessage m = do
|
||||||
d <- asks display
|
d <- asks display
|
||||||
destroyTabs $ map fst $ tabsWindows st
|
destroyTabs $ map fst $ tabsWindows st
|
||||||
io $ freeFont d (fontS st)
|
io $ freeFont d (fontS st)
|
||||||
return $ Just $ Tabbed Nothing conf
|
return $ Just $ Tabbed INothin conf
|
||||||
| otherwise = return Nothing
|
modLay _ _ = return Nothing
|
||||||
|
|
||||||
handleEvent :: TConf -> TabState -> Event -> X ()
|
handleEvent :: TConf -> TabState -> Event -> X ()
|
||||||
-- button press
|
-- button press
|
||||||
|
Reference in New Issue
Block a user