Get rid of layout function
This commit is contained in:
parent
e48e3a6fe0
commit
7a87ba6f2e
7 changed files with 131 additions and 159 deletions
|
|
@ -25,8 +25,6 @@ instance Eq s => Widget (AlphaBox w s c) s (AlphaBoxCache w s c) where
|
|||
|
||||
weight (AlphaBox _ w) = weight w
|
||||
|
||||
layout (AlphaBox _ w) = layout w
|
||||
|
||||
render (AlphaBox alpha w) s x y width height screen = do
|
||||
AlphaBoxCache c <- get
|
||||
(surfaces, c') <- liftIO $ flip runStateT c $ render w s x y width height screen
|
||||
|
|
|
|||
|
|
@ -43,7 +43,7 @@ data ClockState = ClockState !ZonedTime deriving (Show, Eq)
|
|||
data ClockMessage = UpdateTime !ZonedTime deriving (Show, Typeable)
|
||||
|
||||
instance Widget Clock ClockState (RenderCache Clock ClockState) where
|
||||
initWidget (Clock _) phi _ = do
|
||||
initWidget (Clock _) phi _ _ = do
|
||||
forkIO $ forever $ do
|
||||
time <- getZonedTime
|
||||
sendMessage phi $ UpdateTime time
|
||||
|
|
|
|||
|
|
@ -49,11 +49,11 @@ data SystrayMessage = AddIcon !Window !Window | RemoveIcon !Window | RenderIcon
|
|||
|
||||
|
||||
instance Widget Systray SystrayState (RenderCache Systray SystrayState) where
|
||||
initWidget (Systray) phi dispvar = do
|
||||
initWidget (Systray) phi dispvar screens = do
|
||||
phi' <- dupPhi phi
|
||||
forkIO $ systrayRunner phi' dispvar
|
||||
forkIO $ systrayRunner phi' dispvar $ snd . head $ screens
|
||||
|
||||
return $ SystrayState phi (head . getScreens $ dispvar) 0 []
|
||||
return $ SystrayState phi (fst . head $ screens) 0 []
|
||||
|
||||
initCache _ = createRenderCache $ \Systray (SystrayState phi systrayScreen reset icons) x y w h screen -> do
|
||||
when (screen == systrayScreen) $ do
|
||||
|
|
@ -77,12 +77,14 @@ instance Widget Systray SystrayState (RenderCache Systray SystrayState) where
|
|||
Just (AddIcon midParent window) -> SystrayState phi screen reset ((SystrayIconState midParent window):icons)
|
||||
Just (RemoveIcon window) -> SystrayState phi screen reset $ filter (\(SystrayIconState _ stateWindow) -> stateWindow /= window) icons
|
||||
_ -> case (fromMessage m) of
|
||||
Just ResetBackground -> SystrayState phi screen (reset+1) icons
|
||||
_ -> priv
|
||||
Just (UpdateScreens screens) -> SystrayState phi (fst . head $ screens) reset icons
|
||||
_ -> case (fromMessage m) of
|
||||
Just ResetBackground -> SystrayState phi screen (reset+1) icons
|
||||
_ -> priv
|
||||
|
||||
|
||||
systrayRunner :: Phi -> Display -> IO ()
|
||||
systrayRunner phi dispvar = do
|
||||
systrayRunner :: Phi -> Display -> Window -> IO ()
|
||||
systrayRunner phi dispvar panelWindow = do
|
||||
let atoms = getAtoms dispvar
|
||||
initSuccess <- withDisplay dispvar $ flip initSystray atoms
|
||||
|
||||
|
|
@ -94,7 +96,7 @@ systrayRunner phi dispvar = do
|
|||
m <- receiveMessage phi
|
||||
case (fromMessage m) of
|
||||
Just event ->
|
||||
handleEvent event phi dispvar xembedWindow
|
||||
handleEvent event phi dispvar panelWindow xembedWindow
|
||||
_ ->
|
||||
case (fromMessage m) of
|
||||
Just (RenderIcon midParent window x y w h) -> do
|
||||
|
|
@ -188,16 +190,15 @@ sYSTEM_TRAY_CANCEL_MESSAGE = 2
|
|||
xEMBED_EMBEDDED_NOTIFY :: CInt
|
||||
xEMBED_EMBEDDED_NOTIFY = 0
|
||||
|
||||
handleEvent :: Event -> Phi -> Display -> Window -> StateT (M.Map Window Window) IO ()
|
||||
handleEvent message@ClientMessageEvent { ev_message_type = message_type, ev_data = messageData, ev_window = window } phi dispvar xembedWindow = do
|
||||
handleEvent :: Event -> Phi -> Display -> Window -> Window -> StateT (M.Map Window Window) IO ()
|
||||
handleEvent message@ClientMessageEvent { ev_message_type = message_type, ev_data = messageData, ev_window = window } phi dispvar panelWindow xembedWindow = do
|
||||
let atoms = getAtoms dispvar
|
||||
screenWindows = getScreenWindows dispvar
|
||||
when (window == xembedWindow && message_type == atom_NET_SYSTEM_TRAY_OPCODE atoms) $ do
|
||||
case messageData of
|
||||
_:opcode:iconID:_ -> do
|
||||
case True of
|
||||
_ | opcode == sYSTEM_TRAY_REQUEST_DOCK -> do
|
||||
when (iconID /= 0) $ withDisplay dispvar $ \disp -> addIcon phi disp (getAtoms dispvar) (snd . head $ screenWindows) $ fromIntegral iconID
|
||||
when (iconID /= 0) $ withDisplay dispvar $ \disp -> addIcon phi disp (getAtoms dispvar) panelWindow $ fromIntegral iconID
|
||||
|
||||
| opcode == sYSTEM_TRAY_BEGIN_MESSAGE || opcode == sYSTEM_TRAY_CANCEL_MESSAGE ->
|
||||
return ()
|
||||
|
|
@ -210,13 +211,13 @@ handleEvent message@ClientMessageEvent { ev_message_type = message_type, ev_data
|
|||
_ ->
|
||||
return ()
|
||||
|
||||
handleEvent message@UnmapEvent { ev_window = window } phi dispvar xembedWindow =
|
||||
handleEvent message@UnmapEvent { ev_window = window } phi dispvar panelWindow xembedWindow =
|
||||
withDisplay dispvar $ \disp -> removeIcon phi disp True window
|
||||
|
||||
handleEvent message@DestroyWindowEvent { ev_window = window } phi dispvar xembedWindow =
|
||||
handleEvent message@DestroyWindowEvent { ev_window = window } phi dispvar panelWindow xembedWindow =
|
||||
withDisplay dispvar $ \disp -> removeIcon phi disp False window
|
||||
|
||||
handleEvent message@AnyEvent { ev_window = window } phi dispvar xembedWindow | ev_event_type message == reparentNotify = do
|
||||
handleEvent message@AnyEvent { ev_window = window } phi dispvar panelWindow xembedWindow | ev_event_type message == reparentNotify = do
|
||||
parent <- liftIO $ alloca $ \rootPtr -> alloca $ \parentPtr -> alloca $ \childrenPtrPtr -> alloca $ \nChildrenPtr -> do
|
||||
status <- withDisplay dispvar $ \disp -> xQueryTree disp window rootPtr parentPtr childrenPtrPtr nChildrenPtr
|
||||
case status of
|
||||
|
|
@ -232,7 +233,7 @@ handleEvent message@AnyEvent { ev_window = window } phi dispvar xembedWindow | e
|
|||
withDisplay dispvar $ \disp -> removeIcon phi disp False window
|
||||
return ()
|
||||
|
||||
handleEvent _ _ _ _ = return ()
|
||||
handleEvent _ _ _ _ _ = return ()
|
||||
|
||||
|
||||
addIcon :: Phi -> Xlib.Display -> Atoms -> Window -> Window -> StateT (M.Map Window Window) IO ()
|
||||
|
|
|
|||
|
|
@ -137,7 +137,8 @@ defaultTaskbarConfig = TaskbarConfig { taskMaxSize = 200
|
|||
|
||||
data Taskbar = Taskbar TaskbarConfig
|
||||
|
||||
data TaskbarState = TaskbarState { taskbarActiveWindow :: !Window
|
||||
data TaskbarState = TaskbarState { taskbarScreens :: ![Xlib.Rectangle]
|
||||
, taskbarActiveWindow :: !Window
|
||||
, taskbarDesktopCount :: !Int
|
||||
, taskbarCurrentDesktop :: !Int
|
||||
, taskbarWindows :: ![Window]
|
||||
|
|
@ -154,11 +155,11 @@ createIcon size surface = do
|
|||
return $ Icon id size surface
|
||||
|
||||
|
||||
data WindowState = WindowState { windowTitle :: !String
|
||||
, windowDesktop :: !Int
|
||||
, windowVisible :: !Bool
|
||||
, windowIcons :: ![Icon]
|
||||
, windowScreen :: !Xlib.Rectangle
|
||||
data WindowState = WindowState { windowTitle :: !String
|
||||
, windowDesktop :: !Int
|
||||
, windowVisible :: !Bool
|
||||
, windowIcons :: ![Icon]
|
||||
, windowGeometry :: !Xlib.Rectangle
|
||||
} deriving (Eq, Show)
|
||||
|
||||
data WindowCache = WindowCache { createScaledIconCached :: !(IOCache ([Icon], Int) (Maybe Icon))
|
||||
|
|
@ -205,24 +206,26 @@ data TaskbarMessage = WindowListUpdate ![Xlib.Window] !(M.Map Window WindowState
|
|||
deriving (Typeable, Show)
|
||||
|
||||
instance Widget Taskbar TaskbarState (M.Map Window WindowCache) where
|
||||
initWidget (Taskbar _) phi dispvar = do
|
||||
initWidget (Taskbar _) phi dispvar screens = do
|
||||
phi' <- dupPhi phi
|
||||
forkIO $ taskbarRunner phi' dispvar
|
||||
|
||||
return $ TaskbarState 0 0 (-1) [] M.empty
|
||||
return $ TaskbarState (map fst screens) 0 0 (-1) [] M.empty
|
||||
|
||||
initCache _ = M.empty
|
||||
|
||||
minSize _ _ _ _ = 0
|
||||
weight _ = 1
|
||||
|
||||
render (Taskbar config) TaskbarState { taskbarActiveWindow = activeWindow
|
||||
render (Taskbar config) TaskbarState { taskbarScreens = screens
|
||||
, taskbarActiveWindow = activeWindow
|
||||
, taskbarDesktopCount = desktopCount
|
||||
, taskbarCurrentDesktop = currentDesktop
|
||||
, taskbarWindows = windows
|
||||
, taskbarWindowStates = windowStates
|
||||
} _ _ w h screen = do
|
||||
let screenWindows = filter ((== Just screen) . fmap windowScreen . flip M.lookup windowStates) windows
|
||||
let windowScreen w = maximumBy (compare `on` unionArea (windowGeometry w)) screens
|
||||
screenWindows = filter ((== Just screen) . fmap windowScreen . flip M.lookup windowStates) windows
|
||||
desktopNumbers = take desktopCount [0..]
|
||||
desktops = map (\desktop -> (desktop, filter (fromMaybe False . fmap (windowOnDesktop desktop) . flip M.lookup windowStates) screenWindows)) desktopNumbers
|
||||
|
||||
|
|
@ -301,7 +304,9 @@ instance Widget Taskbar TaskbarState (M.Map Window WindowCache) where
|
|||
Just (DesktopCountUpdate count) -> priv {taskbarDesktopCount = count}
|
||||
Just (CurrentDesktopUpdate current) -> priv {taskbarCurrentDesktop = current}
|
||||
Just (ActiveWindowUpdate window) -> priv {taskbarActiveWindow = window}
|
||||
_ -> priv
|
||||
_ -> case (fromMessage m) of
|
||||
Just (UpdateScreens screens) -> priv {taskbarScreens = map fst screens}
|
||||
_ -> priv
|
||||
|
||||
|
||||
renderText :: String -> Int -> Int -> Int -> Int -> String -> Render ()
|
||||
|
|
@ -390,9 +395,8 @@ windowOnDesktop desktop state = (windowVisible state) && (desktop == windowDeskt
|
|||
|
||||
taskbarRunner :: Phi -> Display -> IO ()
|
||||
taskbarRunner phi dispvar = do
|
||||
let screens = getScreens dispvar
|
||||
(windows, states) <- liftIO $ withDisplay dispvar $ \disp -> do
|
||||
(windows, states) <- getWindowStates disp screens (getAtoms dispvar) M.empty
|
||||
(windows, states) <- getWindowStates disp (getAtoms dispvar) M.empty
|
||||
desktopCount <- getDesktopCount disp (getAtoms dispvar)
|
||||
current <- getCurrentDesktop disp (getAtoms dispvar)
|
||||
activeWindow <- getActiveWindow disp (getAtoms dispvar)
|
||||
|
|
@ -406,7 +410,7 @@ taskbarRunner phi dispvar = do
|
|||
flip evalStateT (windows, states) $ forever $ do
|
||||
m <- receiveMessage phi
|
||||
case (fromMessage m) of
|
||||
Just event ->
|
||||
Just event ->
|
||||
handleEvent phi dispvar event
|
||||
_ ->
|
||||
return ()
|
||||
|
|
@ -414,7 +418,6 @@ taskbarRunner phi dispvar = do
|
|||
handleEvent :: Phi -> Display -> XExtras.Event -> StateT ([Window], M.Map Window WindowState) IO ()
|
||||
handleEvent phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, XExtras.ev_window = window} = do
|
||||
let atoms = getAtoms dispvar
|
||||
let screens = getScreens dispvar
|
||||
|
||||
when (elem atom $ Xlib.wM_NAME : map ($ atoms) [ atom_NET_ACTIVE_WINDOW
|
||||
, atom_NET_NUMBER_OF_DESKTOPS
|
||||
|
|
@ -442,7 +445,7 @@ handleEvent phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, XExtras.e
|
|||
sendMessage phi Repaint
|
||||
when (atom == atom_NET_CLIENT_LIST atoms) $ do
|
||||
(windows, windowStates) <- get
|
||||
(windows', windowStates') <- liftIO $ getWindowStates disp screens atoms windowStates
|
||||
(windows', windowStates') <- liftIO $ getWindowStates disp atoms windowStates
|
||||
|
||||
when (windows /= windows') $ do
|
||||
sendMessage phi $ WindowListUpdate windows' windowStates'
|
||||
|
|
@ -476,14 +479,12 @@ handleEvent phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, XExtras.e
|
|||
return ()
|
||||
|
||||
handleEvent phi dispvar XExtras.ConfigureEvent {XExtras.ev_window = window} = do
|
||||
let screens = getScreens dispvar
|
||||
|
||||
(windows, windowStates) <- get
|
||||
when (elem window windows) $ withDisplay dispvar $ \disp -> do
|
||||
let screen = fmap windowScreen . M.lookup window $ windowStates
|
||||
screen' <- liftIO $ getWindowScreen disp screens window
|
||||
when (screen /= (Just screen')) $ do
|
||||
let windowStates' = M.update (\state -> Just state {windowScreen = screen'}) window windowStates
|
||||
let geom = fmap windowGeometry . M.lookup window $ windowStates
|
||||
geom' <- liftIO $ getWindowGeometry disp window
|
||||
when (geom /= (Just geom')) $ do
|
||||
let windowStates' = M.update (\state -> Just state {windowGeometry = geom'}) window windowStates
|
||||
sendMessage phi $ WindowListUpdate windows windowStates'
|
||||
sendMessage phi Repaint
|
||||
put (windows, windowStates')
|
||||
|
|
@ -504,8 +505,8 @@ getActiveWindow :: Xlib.Display -> Atoms -> IO Window
|
|||
getActiveWindow disp atoms =
|
||||
liftM (fromIntegral . fromMaybe 0 . join . fmap listToMaybe) $ XExtras.getWindowProperty32 disp (atom_NET_ACTIVE_WINDOW atoms) $ Xlib.defaultRootWindow disp
|
||||
|
||||
getWindowStates :: Xlib.Display -> [Xlib.Rectangle] -> Atoms -> M.Map Window WindowState -> IO ([Window], M.Map Window WindowState)
|
||||
getWindowStates disp screens atoms windowStates = do
|
||||
getWindowStates :: Xlib.Display -> Atoms -> M.Map Window WindowState -> IO ([Window], M.Map Window WindowState)
|
||||
getWindowStates disp atoms windowStates = do
|
||||
windows <- getWindowList disp atoms
|
||||
|
||||
let windowStates' = map (\w -> (w, M.lookup w windowStates)) windows
|
||||
|
|
@ -517,20 +518,20 @@ getWindowStates disp screens atoms windowStates = do
|
|||
getWindowState' (window, Just windowState) = return (window, windowState)
|
||||
getWindowState' (window, Nothing) = do
|
||||
Xlib.selectInput disp window $ Xlib.propertyChangeMask .|. Xlib.structureNotifyMask
|
||||
windowState <- getWindowState disp screens atoms window
|
||||
windowState <- getWindowState disp atoms window
|
||||
return (window, windowState)
|
||||
|
||||
getWindowState :: Xlib.Display -> [Xlib.Rectangle] -> Atoms -> Window -> IO WindowState
|
||||
getWindowState disp screens atoms window = do
|
||||
getWindowState :: Xlib.Display -> Atoms -> Window -> IO WindowState
|
||||
getWindowState disp atoms window = do
|
||||
(name, workspace, visible) <- getWindowInfo disp atoms window
|
||||
icons <- getWindowIcons disp atoms window
|
||||
screen <- getWindowScreen disp screens window
|
||||
geom <- getWindowGeometry disp window
|
||||
|
||||
return $ WindowState { windowTitle = name
|
||||
, windowDesktop = workspace
|
||||
, windowVisible = visible
|
||||
, windowIcons = icons
|
||||
, windowScreen = screen
|
||||
, windowGeometry = geom
|
||||
}
|
||||
|
||||
getWindowInfo :: Xlib.Display -> Atoms -> Window -> IO (String, Int, Bool)
|
||||
|
|
@ -581,18 +582,12 @@ premultiply c = a .|. r .|. g .|. b
|
|||
b = pm bmask
|
||||
|
||||
|
||||
getWindowScreen :: Xlib.Display -> [Xlib.Rectangle] -> Window -> IO Xlib.Rectangle
|
||||
getWindowScreen disp screens window = flip catch (\_ -> return $ head screens) $ do
|
||||
getWindowGeometry :: Xlib.Display -> Window -> IO Xlib.Rectangle
|
||||
getWindowGeometry disp window = flip catch (\_ -> return $ Xlib.Rectangle 0 0 0 0) $ do
|
||||
(_, _, _, width, height, _, _) <- Xlib.getGeometry disp window
|
||||
(ret, x, y, _) <- Xlib.translateCoordinates disp window (Xlib.defaultRootWindow disp) 0 0
|
||||
|
||||
case ret of
|
||||
True -> do
|
||||
let windowRect = Xlib.Rectangle x y width height
|
||||
screen = maximumBy (compare `on` unionArea windowRect) screens
|
||||
return screen
|
||||
False ->
|
||||
return $ head screens
|
||||
return $ if ret then Xlib.Rectangle x y width height else Xlib.Rectangle 0 0 0 0
|
||||
|
||||
|
||||
showWindow :: Xlib.Display -> Atoms -> Window -> IO Bool
|
||||
|
|
|
|||
Reference in a new issue