Use new XHB backend for Taskbar
This commit is contained in:
parent
15d9304e05
commit
6746d60e3f
6 changed files with 113 additions and 101 deletions
|
@ -37,6 +37,8 @@ import Graphics.Rendering.Cairo
|
|||
import Phi.Phi
|
||||
import Phi.X11.Atoms
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
|
||||
data Display = Display !Connection !Atoms
|
||||
|
||||
|
@ -56,19 +58,19 @@ data XMessage = UpdateScreens [(RECTANGLE, WINDOW)] deriving (Show, Typeable)
|
|||
|
||||
|
||||
unionArea :: RECTANGLE -> RECTANGLE -> Int
|
||||
unionArea a b = fromIntegral $ uw*uh
|
||||
unionArea a b = uw*uh
|
||||
where
|
||||
uw = max 0 $ (min ax2 bx2) - (max ax1 bx1)
|
||||
uh = max 0 $ (min ay2 by2) - (max ay1 by1)
|
||||
uw = max 0 $ (min ax2 bx2) - fromIntegral (max ax1 bx1)
|
||||
uh = max 0 $ (min ay2 by2) - fromIntegral (max ay1 by1)
|
||||
|
||||
MkRECTANGLE ax1 ay1 aw ah = a
|
||||
MkRECTANGLE bx1 by1 bw bh = b
|
||||
|
||||
ax2 = ax1 + fromIntegral aw
|
||||
ay2 = ay1 + fromIntegral ah
|
||||
ax2 = fromIntegral ax1 + fromIntegral aw
|
||||
ay2 = fromIntegral ay1 + fromIntegral ah
|
||||
|
||||
bx2 = bx1 + fromIntegral bw
|
||||
by2 = by1 + fromIntegral bh
|
||||
bx2 = fromIntegral bx1 + fromIntegral bw
|
||||
by2 = fromIntegral by1 + fromIntegral bh
|
||||
|
||||
|
||||
data SurfaceSlice = SurfaceSlice !Int !Surface
|
||||
|
|
|
@ -11,6 +11,7 @@ module Phi.Widgets.Taskbar ( IconStyle
|
|||
, taskbar
|
||||
) where
|
||||
|
||||
import Control.Arrow
|
||||
import Control.Concurrent
|
||||
import Control.Monad
|
||||
import Control.Monad.State.Strict
|
||||
|
@ -38,9 +39,8 @@ import Graphics.Rendering.Pango.Enums (PangoRectangle(..))
|
|||
import Graphics.Rendering.Pango.Layout
|
||||
import Graphics.Rendering.Pango.Font
|
||||
|
||||
import Graphics.X11.Xlib (Window)
|
||||
import qualified Graphics.X11.Xlib as Xlib
|
||||
import qualified Graphics.X11.Xlib.Extras as XExtras
|
||||
import Graphics.XHB
|
||||
import Graphics.XHB.Gen.Xproto
|
||||
|
||||
import Codec.Binary.UTF8.String
|
||||
|
||||
|
@ -49,6 +49,7 @@ import Phi.Types
|
|||
import Phi.Border
|
||||
import Phi.Widget
|
||||
import Phi.X11.Atoms
|
||||
import Phi.X11.Util
|
||||
|
||||
|
||||
newtype IconStyle = IconStyle { withIconStyle :: Surface -> Render () }
|
||||
|
@ -137,13 +138,13 @@ defaultTaskbarConfig = TaskbarConfig { taskMaxSize = 200
|
|||
|
||||
data Taskbar = Taskbar TaskbarConfig
|
||||
|
||||
data TaskbarState = TaskbarState { taskbarScreens :: ![Xlib.Rectangle]
|
||||
, taskbarActiveWindow :: !Window
|
||||
data TaskbarState = TaskbarState { taskbarScreens :: ![RECTANGLE]
|
||||
, taskbarActiveWindow :: !WINDOW
|
||||
, taskbarDesktopCount :: !Int
|
||||
, taskbarCurrentDesktop :: !Int
|
||||
, taskbarDesktopNames :: ![String]
|
||||
, taskbarWindows :: ![Window]
|
||||
, taskbarWindowStates :: !(M.Map Window WindowState)
|
||||
, taskbarWindows :: ![WINDOW]
|
||||
, taskbarWindowStates :: !(M.Map WINDOW WindowState)
|
||||
} deriving Eq
|
||||
|
||||
data Icon = Icon !Unique !Int !Surface
|
||||
|
@ -160,7 +161,7 @@ data WindowState = WindowState { windowTitle :: !String
|
|||
, windowDesktop :: !Int
|
||||
, windowVisible :: !Bool
|
||||
, windowIcons :: ![Icon]
|
||||
, windowGeometry :: !Xlib.Rectangle
|
||||
, windowGeometry :: !RECTANGLE
|
||||
} deriving (Eq, Show)
|
||||
|
||||
data WindowCache = WindowCache { createScaledIconCached :: !(IOCache ([Icon], Int) (Maybe Icon))
|
||||
|
@ -179,7 +180,7 @@ emptyWindowCache = WindowCache { createScaledIconCached = createIOCache createSc
|
|||
}
|
||||
|
||||
data TaskbarCache = TaskbarCache { desktopCaches :: !(M.Map Int DesktopCache)
|
||||
, windowCaches :: !(M.Map Window WindowCache)
|
||||
, windowCaches :: !(M.Map WINDOW WindowCache)
|
||||
}
|
||||
|
||||
-- substitute for the liftT function in Data.Accessor.MonadState that uses the strict StateT variant
|
||||
|
@ -200,19 +201,19 @@ liftIOStateT m = do
|
|||
cached :: (MonadIO m, Eq a) => A.T s (IOCache a b) -> a -> StateT s m b
|
||||
cached t = liftT t . liftIOStateT . runIOCache
|
||||
|
||||
data TaskbarMessage = WindowListUpdate ![Xlib.Window] !(M.Map Window WindowState)
|
||||
data TaskbarMessage = WindowListUpdate ![WINDOW] !(M.Map WINDOW WindowState)
|
||||
| DesktopCountUpdate !Int
|
||||
| CurrentDesktopUpdate !Int
|
||||
| DesktopNamesUpdate ![String]
|
||||
| ActiveWindowUpdate !Window
|
||||
| ActiveWindowUpdate !WINDOW
|
||||
deriving (Typeable, Show)
|
||||
|
||||
instance Widget Taskbar TaskbarState (M.Map Window WindowCache) where
|
||||
instance Widget Taskbar TaskbarState (M.Map WINDOW WindowCache) where
|
||||
initWidget (Taskbar _) phi dispvar screens = do
|
||||
phi' <- dupPhi phi
|
||||
forkIO $ taskbarRunner phi' dispvar
|
||||
|
||||
return $ TaskbarState (map fst screens) 0 0 (-1) [] [] M.empty
|
||||
return $ TaskbarState (map fst screens) (fromXid xidNone) 0 (-1) [] [] M.empty
|
||||
|
||||
initCache _ = M.empty
|
||||
|
||||
|
@ -416,47 +417,57 @@ taskbarRunner phi dispvar = do
|
|||
flip evalStateT (windows, states) $ forever $ do
|
||||
m <- receiveMessage phi
|
||||
case (fromMessage m) of
|
||||
Just event ->
|
||||
Just (XEvent event) ->
|
||||
handleEvent phi dispvar event
|
||||
_ ->
|
||||
return ()
|
||||
|
||||
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
|
||||
|
||||
handleEvent :: Phi -> Display -> SomeEvent -> StateT ([WINDOW], M.Map WINDOW WindowState) IO ()
|
||||
handleEvent phi dispvar event =
|
||||
case (fromEvent event) of
|
||||
Just e -> handlePropertyNotifyEvent phi dispvar e
|
||||
Nothing -> case (fromEvent event) of
|
||||
Just e -> handleConfigureNotifyEvent phi dispvar e
|
||||
Nothing -> return ()
|
||||
|
||||
handlePropertyNotifyEvent :: Phi -> Display -> PropertyNotifyEvent -> StateT ([WINDOW], M.Map WINDOW WindowState) IO ()
|
||||
handlePropertyNotifyEvent phi dispvar MkPropertyNotifyEvent {atom_PropertyNotifyEvent = atom, window_PropertyNotifyEvent = window} = do
|
||||
let atoms = getAtoms dispvar
|
||||
|
||||
when (elem atom $ Xlib.wM_NAME : map ($ atoms) [ atom_NET_ACTIVE_WINDOW
|
||||
, atom_NET_NUMBER_OF_DESKTOPS
|
||||
, atom_NET_CURRENT_DESKTOP
|
||||
, atom_NET_DESKTOP_NAMES
|
||||
, atom_NET_CLIENT_LIST
|
||||
, atom_NET_WM_ICON
|
||||
, atom_NET_WM_NAME
|
||||
, atom_NET_WM_DESKTOP
|
||||
, atom_NET_WM_STATE
|
||||
]) $ withDisplay dispvar $ \disp -> do
|
||||
let rootwin = Xlib.defaultRootWindow disp
|
||||
when (elem atom $ map ($ atoms) [ atom_NET_ACTIVE_WINDOW
|
||||
, atom_NET_NUMBER_OF_DESKTOPS
|
||||
, atom_NET_CURRENT_DESKTOP
|
||||
, atom_NET_DESKTOP_NAMES
|
||||
, atom_NET_CLIENT_LIST
|
||||
, atom_NET_WM_ICON
|
||||
, atomWM_NAME
|
||||
, atom_NET_WM_NAME
|
||||
, atom_NET_WM_DESKTOP
|
||||
, atom_NET_WM_STATE
|
||||
]) $ withDisplay dispvar $ \conn -> do
|
||||
let rootwin = getRoot conn
|
||||
if (window == rootwin)
|
||||
then do
|
||||
when (atom == atom_NET_ACTIVE_WINDOW atoms) $ do
|
||||
activeWindow <- liftIO $ getActiveWindow disp atoms
|
||||
activeWindow <- liftIO $ getActiveWindow conn atoms
|
||||
sendMessage phi $ ActiveWindowUpdate activeWindow
|
||||
sendMessage phi Repaint
|
||||
when (atom == atom_NET_NUMBER_OF_DESKTOPS atoms) $ do
|
||||
desktopCount <- liftIO $ getDesktopCount disp atoms
|
||||
desktopCount <- liftIO $ getDesktopCount conn atoms
|
||||
sendMessage phi $ DesktopCountUpdate desktopCount
|
||||
sendMessage phi Repaint
|
||||
when (atom == atom_NET_CURRENT_DESKTOP atoms) $ do
|
||||
current <- liftIO $ getCurrentDesktop disp atoms
|
||||
current <- liftIO $ getCurrentDesktop conn atoms
|
||||
sendMessage phi $ CurrentDesktopUpdate current
|
||||
sendMessage phi Repaint
|
||||
when (atom == atom_NET_DESKTOP_NAMES atoms) $ do
|
||||
names <- liftIO $ getDesktopNames disp atoms
|
||||
names <- liftIO $ getDesktopNames conn atoms
|
||||
sendMessage phi $ DesktopNamesUpdate names
|
||||
sendMessage phi Repaint
|
||||
when (atom == atom_NET_CLIENT_LIST atoms) $ do
|
||||
(windows, windowStates) <- get
|
||||
(windows', windowStates') <- liftIO $ getWindowStates disp atoms windowStates
|
||||
(windows', windowStates') <- liftIO $ getWindowStates conn atoms windowStates
|
||||
|
||||
when (windows /= windows') $ do
|
||||
sendMessage phi $ WindowListUpdate windows' windowStates'
|
||||
|
@ -468,14 +479,14 @@ handleEvent phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, XExtras.e
|
|||
when (elem window windows) $ do
|
||||
case () of
|
||||
_ | (atom == atom_NET_WM_ICON atoms) -> do
|
||||
icons <- liftIO $ getWindowIcons disp atoms window
|
||||
icons <- liftIO $ getWindowIcons conn atoms window
|
||||
let windowStates' = M.update (\state -> Just state {windowIcons = icons}) window windowStates
|
||||
sendMessage phi $ WindowListUpdate windows windowStates'
|
||||
sendMessage phi Repaint
|
||||
put (windows, windowStates')
|
||||
|
||||
| otherwise -> do
|
||||
(name, desktop, visible) <- liftIO $ getWindowInfo disp atoms window
|
||||
(name, desktop, visible) <- liftIO $ getWindowInfo conn atoms window
|
||||
let mwindowState = M.lookup window windowStates
|
||||
case mwindowState of
|
||||
Just windowState -> do
|
||||
|
@ -489,44 +500,44 @@ handleEvent phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, XExtras.e
|
|||
Nothing ->
|
||||
return ()
|
||||
|
||||
handleEvent phi dispvar XExtras.ConfigureEvent {XExtras.ev_window = window} = do
|
||||
|
||||
handleConfigureNotifyEvent :: Phi -> Display -> ConfigureNotifyEvent -> StateT ([WINDOW], M.Map WINDOW WindowState) IO ()
|
||||
handleConfigureNotifyEvent phi dispvar MkConfigureNotifyEvent {window_ConfigureNotifyEvent = window} = do
|
||||
(windows, windowStates) <- get
|
||||
when (elem window windows) $ withDisplay dispvar $ \disp -> do
|
||||
let geom = fmap windowGeometry . M.lookup window $ windowStates
|
||||
geom' <- liftIO $ getWindowGeometry disp window
|
||||
when (elem window windows) $ withDisplay dispvar $ \conn -> do
|
||||
let geom = fmap windowGeometry . M.lookup window $ windowStates
|
||||
geom' <- liftIO $ getWindowGeometry conn 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')
|
||||
|
||||
handleEvent _ _ _ = return ()
|
||||
|
||||
getDesktopCount :: Connection -> Atoms -> IO Int
|
||||
getDesktopCount conn atoms =
|
||||
liftM (fromIntegral . fromMaybe 0 . join . fmap listToMaybe) $ getProperty32 conn (getRoot conn) (atom_NET_NUMBER_OF_DESKTOPS atoms)
|
||||
|
||||
getDesktopCount :: Xlib.Display -> Atoms -> IO Int
|
||||
getDesktopCount disp atoms =
|
||||
liftM (fromIntegral . fromMaybe 0 . join . fmap listToMaybe) $ XExtras.getWindowProperty32 disp (atom_NET_NUMBER_OF_DESKTOPS atoms) $ Xlib.defaultRootWindow disp
|
||||
getCurrentDesktop :: Connection -> Atoms -> IO Int
|
||||
getCurrentDesktop conn atoms =
|
||||
liftM (fromIntegral . fromMaybe (-1) . join . fmap listToMaybe) $ getProperty32 conn (getRoot conn) (atom_NET_CURRENT_DESKTOP atoms)
|
||||
|
||||
getCurrentDesktop :: Xlib.Display -> Atoms -> IO Int
|
||||
getCurrentDesktop disp atoms =
|
||||
liftM (fromIntegral . fromMaybe (-1) . join . fmap listToMaybe) $ XExtras.getWindowProperty32 disp (atom_NET_CURRENT_DESKTOP atoms) $ Xlib.defaultRootWindow disp
|
||||
|
||||
getDesktopNames :: Xlib.Display -> Atoms -> IO [String]
|
||||
getDesktopNames disp atoms =
|
||||
liftM (map (decode . map fromIntegral) . break' . fromMaybe []) $ XExtras.getWindowProperty8 disp (atom_NET_DESKTOP_NAMES atoms) $ Xlib.defaultRootWindow disp
|
||||
getDesktopNames :: Connection -> Atoms -> IO [String]
|
||||
getDesktopNames conn atoms =
|
||||
liftM (map (decode . map fromIntegral) . break' . fromMaybe []) $ getProperty8 conn (getRoot conn) (atom_NET_DESKTOP_NAMES atoms)
|
||||
where
|
||||
break' l = case dropWhile (== 0) l of
|
||||
[] -> []
|
||||
l' -> w : break' l''
|
||||
where (w, l'') = break (== 0) l'
|
||||
|
||||
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
|
||||
getActiveWindow :: Connection -> Atoms -> IO WINDOW
|
||||
getActiveWindow conn atoms =
|
||||
liftM (fromXid . toXid . fromMaybe 0 . join . fmap listToMaybe) $ getProperty32 conn (getRoot conn) (atom_NET_ACTIVE_WINDOW atoms)
|
||||
|
||||
getWindowStates :: Xlib.Display -> Atoms -> M.Map Window WindowState -> IO ([Window], M.Map Window WindowState)
|
||||
getWindowStates disp atoms windowStates = do
|
||||
windows <- getWindowList disp atoms
|
||||
getWindowStates :: Connection -> Atoms -> M.Map WINDOW WindowState -> IO ([WINDOW], M.Map WINDOW WindowState)
|
||||
getWindowStates conn atoms windowStates = do
|
||||
windows <- getWindowList conn atoms
|
||||
|
||||
let windowStates' = map (\w -> (w, M.lookup w windowStates)) windows
|
||||
|
||||
|
@ -536,15 +547,15 @@ getWindowStates disp atoms windowStates = do
|
|||
where
|
||||
getWindowState' (window, Just windowState) = return (window, windowState)
|
||||
getWindowState' (window, Nothing) = do
|
||||
Xlib.selectInput disp window $ Xlib.propertyChangeMask .|. Xlib.structureNotifyMask
|
||||
windowState <- getWindowState disp atoms window
|
||||
changeWindowAttributes conn window $ toValueParam [(CWEventMask, toMask [EventMaskPropertyChange, EventMaskStructureNotify])]
|
||||
windowState <- getWindowState conn atoms window
|
||||
return (window, windowState)
|
||||
|
||||
getWindowState :: Xlib.Display -> Atoms -> Window -> IO WindowState
|
||||
getWindowState disp atoms window = do
|
||||
(name, workspace, visible) <- getWindowInfo disp atoms window
|
||||
icons <- getWindowIcons disp atoms window
|
||||
geom <- getWindowGeometry disp window
|
||||
getWindowState :: Connection -> Atoms -> WINDOW -> IO WindowState
|
||||
getWindowState conn atoms window = do
|
||||
(name, workspace, visible) <- getWindowInfo conn atoms window
|
||||
icons <- getWindowIcons conn atoms window
|
||||
geom <- getWindowGeometry conn window
|
||||
|
||||
return $ WindowState { windowTitle = name
|
||||
, windowDesktop = workspace
|
||||
|
@ -553,25 +564,25 @@ getWindowState disp atoms window = do
|
|||
, windowGeometry = geom
|
||||
}
|
||||
|
||||
getWindowInfo :: Xlib.Display -> Atoms -> Window -> IO (String, Int, Bool)
|
||||
getWindowInfo disp atoms window = do
|
||||
netwmname <- liftM (fmap (decode . map fromIntegral)) $ XExtras.getWindowProperty8 disp (atom_NET_WM_NAME atoms) window
|
||||
getWindowInfo :: Connection -> Atoms -> WINDOW -> IO (String, Int, Bool)
|
||||
getWindowInfo conn atoms window = do
|
||||
netwmname <- liftM (fmap (decode . map fromIntegral)) $ getProperty8 conn window (atom_NET_WM_NAME atoms)
|
||||
wmname <- case netwmname of
|
||||
Just name -> return name
|
||||
Nothing -> liftM (map unsignedChr . fromMaybe []) $ XExtras.getWindowProperty8 disp Xlib.wM_NAME window
|
||||
Nothing -> liftM (map unsignedChr . fromMaybe []) $ getProperty8 conn window (atom_NET_WM_NAME atoms)
|
||||
|
||||
workspace <- liftM (fromIntegral . fromMaybe 0xFFFFFFFF . join . fmap listToMaybe) $ XExtras.getWindowProperty32 disp (atom_NET_WM_DESKTOP atoms) window
|
||||
visible <- showWindow disp atoms window
|
||||
workspace <- liftM (fromIntegral . fromMaybe 0xFFFFFFFF . join . fmap listToMaybe) $ getProperty32 conn window (atom_NET_WM_DESKTOP atoms)
|
||||
visible <- showWindow conn atoms window
|
||||
|
||||
return (wmname, workspace, visible)
|
||||
where
|
||||
unsignedChr = chr . fromIntegral . (fromIntegral :: (CChar -> CUChar))
|
||||
unsignedChr = chr . fromIntegral
|
||||
|
||||
getWindowIcons :: Xlib.Display -> Atoms -> Window -> IO [Icon]
|
||||
getWindowIcons disp atoms window = XExtras.getWindowProperty32 disp (atom_NET_WM_ICON atoms) window >>= readIcons . fromMaybe []
|
||||
getWindowIcons :: Connection -> Atoms -> WINDOW -> IO [Icon]
|
||||
getWindowIcons conn atoms window = getProperty32 conn window (atom_NET_WM_ICON atoms) >>= readIcons . fromMaybe []
|
||||
|
||||
|
||||
readIcons :: [CLong] -> IO [Icon]
|
||||
readIcons :: [Word32] -> IO [Icon]
|
||||
readIcons (width:height:iconData) = do
|
||||
if ((fromIntegral $ length iconData) < (width*height)) then return [] else do
|
||||
let (thisIcon, rest) = splitAt (fromIntegral (width*height)) iconData
|
||||
|
@ -601,22 +612,19 @@ premultiply c = a .|. r .|. g .|. b
|
|||
b = pm bmask
|
||||
|
||||
|
||||
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
|
||||
|
||||
return $ if ret then Xlib.Rectangle x y width height else Xlib.Rectangle 0 0 0 0
|
||||
|
||||
getWindowGeometry :: Connection -> WINDOW -> IO RECTANGLE
|
||||
getWindowGeometry conn window =
|
||||
getGeometry conn (fromXid . toXid $ window) >>= getReply >>= return . ((const $ MkRECTANGLE 0 0 0 0) ||| (\(MkGetGeometryReply _ _ x y width height _) -> MkRECTANGLE x y width height))
|
||||
|
||||
showWindow :: Xlib.Display -> Atoms -> Window -> IO Bool
|
||||
showWindow disp atoms window = do
|
||||
states <- liftM (map fromIntegral . fromMaybe []) $ XExtras.getWindowProperty32 disp (atom_NET_WM_STATE atoms) window
|
||||
transientForHint <- XExtras.getTransientForHint disp window
|
||||
windowType <- liftM (fromMaybe (atom_NET_WM_WINDOW_TYPE_NORMAL atoms) . fmap fromIntegral . join . fmap listToMaybe) $ XExtras.getWindowProperty32 disp (atom_NET_WM_STATE atoms) window
|
||||
showWindow :: Connection -> Atoms -> WINDOW -> IO Bool
|
||||
showWindow conn atoms window = do
|
||||
states <- liftM (map (fromXid . toXid) . fromMaybe []) $ getProperty32 conn window (atom_NET_WM_STATE atoms)
|
||||
transientFor <- liftM (map fromIntegral . fromMaybe []) $ getProperty32 conn window (atomWM_TRANSIENT_FOR atoms)
|
||||
windowType <- liftM (fromMaybe (atom_NET_WM_WINDOW_TYPE_NORMAL atoms) . fmap (fromXid . toXid) . join . fmap listToMaybe) $
|
||||
getProperty32 conn window (atom_NET_WM_STATE atoms)
|
||||
|
||||
return $ not $ or [ elem (atom_NET_WM_STATE_SKIP_TASKBAR atoms) states
|
||||
, transientForHint /= Nothing
|
||||
, transientFor /= [] && transientFor /= [0]
|
||||
, elem windowType $ map ($ atoms) [ atom_NET_WM_WINDOW_TYPE_DOCK
|
||||
, atom_NET_WM_WINDOW_TYPE_DESKTOP
|
||||
, atom_NET_WM_WINDOW_TYPE_TOOLBAR
|
||||
|
@ -626,8 +634,8 @@ showWindow disp atoms window = do
|
|||
]
|
||||
|
||||
|
||||
getWindowList :: Xlib.Display -> Atoms -> IO [Window]
|
||||
getWindowList disp atoms = liftM (map fromIntegral . join . maybeToList) $ XExtras.getWindowProperty32 disp (atom_NET_CLIENT_LIST atoms) $ Xlib.defaultRootWindow disp
|
||||
getWindowList :: Connection -> Atoms -> IO [WINDOW]
|
||||
getWindowList conn atoms = liftM (map (fromXid . toXid) . join . maybeToList) $ getProperty32 conn (getRoot conn) (atom_NET_CLIENT_LIST atoms)
|
||||
|
||||
taskbar :: TaskbarConfig -> Taskbar
|
||||
taskbar = Taskbar
|
||||
|
|
|
@ -191,7 +191,7 @@ handleMessage conn xcb m = do
|
|||
return ()
|
||||
|
||||
handleEvent :: (Widget w s c) => Connection -> XCB.Connection -> SomeEvent -> PhiX w s c ()
|
||||
handleEvent conn xcb event = do
|
||||
handleEvent conn xcb event =
|
||||
case (fromEvent event) of
|
||||
Just e -> handlePropertyNotifyEvent conn xcb e
|
||||
Nothing -> case (fromEvent event) of
|
||||
|
@ -253,6 +253,7 @@ handleConfigureNotifyEvent conn MkConfigureNotifyEvent { window_ConfigureNotifyE
|
|||
sendMessage phi $ UpdateScreens $ map (panelScreenArea &&& panelWindow) panels'
|
||||
sendMessage phi Repaint
|
||||
|
||||
handleConfigureNotifyEvent _ _ = return ()
|
||||
|
||||
receiveEvents :: Phi -> Connection -> IO ()
|
||||
receiveEvents phi conn = do
|
||||
|
|
|
@ -16,6 +16,7 @@ atoms = [ "ATOM"
|
|||
, "UTF8_STRING"
|
||||
, "WM_NAME"
|
||||
, "WM_CLASS"
|
||||
, "WM_TRANSIENT_FOR"
|
||||
, "MANAGER"
|
||||
, "_NET_WM_NAME"
|
||||
, "_NET_WM_WINDOW_TYPE"
|
||||
|
|
Reference in a new issue