neocturne/phi
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Taskbar: Sort windows by screen

Browse source
This commit is contained in:
Matthias Schiffer 2011-07-16 15:55:31 +02:00
parent 8854f0aec4
commit b66d6690d8
6 changed files with 175 additions and 110 deletions
Download patch file Download diff file Expand all files Collapse all files

2
lib/Phi/Widgets/Clock.hs
View file

@ -57,7 +57,7 @@ instance WidgetClass Clock where
minSize (Clock config ) = clockSize config
render (Clock config) (ClockState time) w h = do
render (Clock config) (ClockState time) w h _ = do
time <- liftIO getZonedTime
let (r, g, b, a) = fontColor config
str = formatTime defaultTimeLocale (clockFormat config) time

214
lib/Phi/Widgets/Taskbar.hs
View file

@ -122,6 +122,7 @@ data TaskbarState = TaskbarState { taskbarActiveWindow :: !Window
, taskbarWindows :: ![Window]
, taskbarWindowStates :: !(M.Map Window WindowState)
, taskbarWindowIcons :: !(M.Map Window [(Int, Surface)])
, taskbarWindowScreens :: !(M.Map Window Xlib.Rectangle)
} deriving Show
data WindowState = WindowState { windowTitle :: !String
@ -129,7 +130,7 @@ data WindowState = WindowState { windowTitle :: !String
, windowVisible :: !Bool
} deriving (Show, Eq)
data TaskbarMessage = WindowListUpdate [Xlib.Window] (M.Map Window WindowState) (M.Map Window [(Int, Surface)])
data TaskbarMessage = WindowListUpdate [Xlib.Window] (M.Map Window WindowState) (M.Map Window [(Int, Surface)]) (M.Map Window Xlib.Rectangle)
| DesktopCountUpdate Int
| CurrentDesktopUpdate Int
| ActiveWindowUpdate Window
@ -141,7 +142,7 @@ instance WidgetClass Taskbar where
initWidget (Taskbar _) phi dispvar = do
forkIO $ taskbarRunner phi dispvar
return $ TaskbarState 0 0 (-1) [] M.empty M.empty
return $ TaskbarState 0 0 (-1) [] M.empty M.empty M.empty
minSize _ = 0
@ -153,9 +154,11 @@ instance WidgetClass Taskbar where
, taskbarWindows = windows
, taskbarWindowStates = windowStates
, taskbarWindowIcons = windowIcons
} w h = do
let desktopNumbers = take desktopCount [0..]
desktops = map (\desktop -> (desktop, filter (fromMaybe False . fmap (windowOnDesktop desktop) . flip M.lookup windowStates) windows)) desktopNumbers
, taskbarWindowScreens = windowScreens
} w h screen = do
let screenWindows = filter ((== Just screen) . flip M.lookup windowScreens) windows
desktopNumbers = take desktopCount [0..]
desktops = map (\desktop -> (desktop, filter (fromMaybe False . fmap (windowOnDesktop desktop) . flip M.lookup windowStates) screenWindows)) desktopNumbers
windowCount = sum $ map (length . snd) $ desktops
dstyle d = fmap (if d == currentDesktop then snd else fst) $ desktopStyle config
dlabelwidth d = fromMaybe 0 $ fmap desktopLabelWidth $ dstyle d
@ -166,75 +169,73 @@ instance WidgetClass Taskbar where
dwidth d = fromMaybe 0 $ fmap (\ds@DesktopStyle {desktopBorder = border}
-> (borderH $ margin border) + 2*(borderWidth border) + (borderH $ padding border)
+ dlabelwidth d + gap d ds) $ dstyle d
when (windowCount /= 0) $ do
let desktopsWidth = sum $ map dwidth desktopNumbers
windowWidth = min (taskMaxSize config) ((w - desktopsWidth) `div` windowCount)
desktopsWidth = sum $ map dwidth desktopNumbers
windowWidth = if windowCount == 0 then 0 else min (taskMaxSize config) ((w - desktopsWidth) `div` windowCount)
flip (flip foldM_ 0) desktops $ \nwindows (desktop, desktopWindows) -> do
let dstyle' = dstyle desktop
dx = dleftwidth desktop + (sum $ map dwidth $ take desktop [0..]) + nwindows*windowWidth
flip (flip foldM_ 0) desktops $ \nwindows (desktop, desktopWindows) -> do
let dstyle' = dstyle desktop
dx = dleftwidth desktop + (sum $ map dwidth $ take desktop [0..]) + nwindows*windowWidth
case dstyle' of
Just ds -> do
let (r, g, b, a) = desktopColor ds
save
drawBorder (desktopBorder ds) (dx - dleftwidth desktop) 0 (dwidth desktop + windowWidth * length desktopWindows) h
clip
setSourceRGBA r g b a
renderText (desktopFont ds) (fromIntegral (dx - dlabelwidth desktop - gap desktop ds)) 0 (dlabelwidth desktop) h $ show (desktop+1)
restore
_ -> return ()
forM_ (zip [0..] desktopWindows) $ \(i, window) -> do
let style = (if window == activeWindow then activeTaskStyle else normalTaskStyle) config
(r, g, b, a) = taskColor style
leftBorder = (borderLeft $ margin $ taskBorder style) + (borderWidth $ taskBorder style) + (borderLeft $ padding $ taskBorder style)
rightBorder = (borderRight $ margin $ taskBorder style) + (borderWidth $ taskBorder style) + (borderRight $ padding $ taskBorder style)
h' = h - (borderV $ margin $ taskBorder style)
mstate = M.lookup window windowStates
micons = M.lookup window windowIcons
x = dx + i*windowWidth
case dstyle' of
Just ds -> do
let (r, g, b, a) = desktopColor ds
case (mstate, micons) of
(Just state, Just icons) -> do
save
drawBorder (desktopBorder ds) (dx - dleftwidth desktop) 0 (dwidth desktop + windowWidth * length desktopWindows) h
drawBorder (taskBorder style) x 0 windowWidth h
clip
setSourceRGBA r g b a
renderText (desktopFont ds) (fromIntegral (dx - dlabelwidth desktop - gap desktop ds)) 0 (dlabelwidth desktop) h $ show (desktop+1)
renderText (taskFont style) (fromIntegral (x + leftBorder + h' + 3)) 0 (windowWidth - leftBorder - h' - 3 - rightBorder) h $ windowTitle state
restore
_ -> return ()
forM_ (zip [0..] desktopWindows) $ \(i, window) -> do
let style = (if window == activeWindow then activeTaskStyle else normalTaskStyle) config
(r, g, b, a) = taskColor style
leftBorder = (borderLeft $ margin $ taskBorder style) + (borderWidth $ taskBorder style) + (borderLeft $ padding $ taskBorder style)
rightBorder = (borderRight $ margin $ taskBorder style) + (borderWidth $ taskBorder style) + (borderRight $ padding $ taskBorder style)
h' = h - (borderV $ margin $ taskBorder style)
mstate = M.lookup window windowStates
micons = M.lookup window windowIcons
x = dx + i*windowWidth
case (mstate, micons) of
(Just state, Just icons) -> do
save
drawBorder (taskBorder style) x 0 windowWidth h
clip
setSourceRGBA r g b a
renderText (taskFont style) (fromIntegral (x + leftBorder + h' + 3)) 0 (windowWidth - leftBorder - h' - 3 - rightBorder) h $ windowTitle state
restore
case bestIcon h' icons of
Just icon -> do
save
translate (fromIntegral $ x + leftBorder) (fromIntegral $ borderTop $ margin $ taskBorder style)
imageW <- imageSurfaceGetWidth icon
imageH <- imageSurfaceGetHeight icon
let scalef = (fromIntegral h')/(fromIntegral $ max imageW imageH)
scale scalef scalef
when (imageH < imageW) $
translate 0 $ (fromIntegral (imageW-imageH))/2
taskIconStyle style icon
paint
restore
Nothing -> return ()
_ -> return ()
return $ nwindows + length desktopWindows
case bestIcon h' icons of
Just icon -> do
save
translate (fromIntegral $ x + leftBorder) (fromIntegral $ borderTop $ margin $ taskBorder style)
imageW <- imageSurfaceGetWidth icon
imageH <- imageSurfaceGetHeight icon
let scalef = (fromIntegral h')/(fromIntegral $ max imageW imageH)
scale scalef scalef
when (imageH < imageW) $
translate 0 $ (fromIntegral (imageW-imageH))/2
taskIconStyle style icon
paint
restore
Nothing -> return ()
_ -> return ()
return $ nwindows + length desktopWindows
handleMessage _ priv m = case (fromMessage m) of
Just (WindowListUpdate windows windowStates icons) -> priv {taskbarWindows = windows, taskbarWindowStates = windowStates, taskbarWindowIcons = icons}
Just (WindowListUpdate windows windowStates icons screens) -> priv {taskbarWindows = windows, taskbarWindowStates = windowStates, taskbarWindowIcons = icons, taskbarWindowScreens = screens}
Just (DesktopCountUpdate count) -> priv {taskbarDesktopCount = count}
Just (CurrentDesktopUpdate current) -> priv {taskbarCurrentDesktop = current}
Just (ActiveWindowUpdate window) -> priv {taskbarActiveWindow = window}
@ -267,29 +268,31 @@ windowOnDesktop desktop state = (windowVisible state) && (desktop == windowDeskt
taskbarRunner :: Phi -> Display -> IO ()
taskbarRunner phi dispvar = do
(windows, states, icons) <- liftIO $ withDisplay dispvar $ \disp -> do
(windows, states, icons) <- getWindowStates disp (getAtoms dispvar) [] M.empty M.empty
let screens = getScreens dispvar
(windows, states, icons, windowScreens) <- liftIO $ withDisplay dispvar $ \disp -> do
(windows, states, icons, windowScreens) <- getWindowStates disp screens (getAtoms dispvar) [] M.empty M.empty M.empty
desktopCount <- getDesktopCount disp (getAtoms dispvar)
current <- getCurrentDesktop disp (getAtoms dispvar)
activeWindow <- getActiveWindow disp (getAtoms dispvar)
sendMessage phi $ WindowListUpdate windows states icons
sendMessage phi $ WindowListUpdate windows states icons windowScreens
sendMessage phi $ DesktopCountUpdate desktopCount
sendMessage phi $ CurrentDesktopUpdate current
sendMessage phi $ ActiveWindowUpdate activeWindow
return (windows, states, icons)
return (windows, states, icons, windowScreens)
sendMessage phi Repaint
flip evalStateT (windows, states, icons) $ forever $ do
flip evalStateT (windows, states, icons, windowScreens) $ forever $ do
m <- receiveMessage phi
case (fromMessage m) of
Just event@XExtras.PropertyEvent {} ->
handlePropertyUpdate phi dispvar event
Just event ->
handleEvent phi dispvar event
_ ->
return ()
handlePropertyUpdate :: Phi -> Display -> XExtras.Event -> StateT ([Window], M.Map Window WindowState, M.Map Window [(Int, Surface)]) IO ()
handlePropertyUpdate phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, XExtras.ev_window = window} = do
handleEvent :: Phi -> Display -> XExtras.Event -> StateT ([Window], M.Map Window WindowState, M.Map Window [(Int, Surface)], M.Map Window Xlib.Rectangle) 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 $ map ($ atoms) [ atom_NET_ACTIVE_WINDOW
, atom_NET_NUMBER_OF_DESKTOPS
@ -317,23 +320,23 @@ handlePropertyUpdate phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom,
sendMessage phi $ CurrentDesktopUpdate current
sendMessage phi Repaint
when (atom == atom_NET_CLIENT_LIST atoms) $ do
(windows, windowStates, icons) <- get
(windows', windowStates', icons') <- liftIO $ getWindowStates disp atoms windows windowStates icons
(windows, windowStates, icons, windowScreens) <- get
(windows', windowStates', icons', windowScreens') <- liftIO $ getWindowStates disp screens atoms windows windowStates icons windowScreens
when (windows /= windows') $ do
sendMessage phi $ WindowListUpdate windows' windowStates' icons'
sendMessage phi $ WindowListUpdate windows' windowStates' icons' windowScreens'
sendMessage phi Repaint
put (windows', windowStates', icons')
put (windows', windowStates', icons', windowScreens')
else do
(windows, windowStates, icons) <- get
(windows, windowStates, icons, windowScreens) <- get
when (elem window windows) $ do
when (atom == atom_NET_WM_ICON atoms) $ do
icon <- liftIO $ getWindowIcons disp atoms window
let icons' = M.insert window icon icons
sendMessage phi $ WindowListUpdate windows windowStates icons'
sendMessage phi $ WindowListUpdate windows windowStates icons' windowScreens
sendMessage phi Repaint
put (windows, windowStates, icons')
put (windows, windowStates, icons', windowScreens)
when (atom /= atom_NET_WM_ICON atoms) $ do
let windowState = M.lookup window windowStates
@ -341,14 +344,31 @@ handlePropertyUpdate phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom,
when (windowState /= (Just windowState')) $ do
let windowStates' = M.insert window windowState' windowStates
sendMessage phi $ WindowListUpdate windows windowStates' icons
sendMessage phi $ WindowListUpdate windows windowStates' icons windowScreens
sendMessage phi Repaint
put (windows, windowStates', icons)
put (windows, windowStates', icons, windowScreens)
handleEvent phi dispvar XExtras.ConfigureEvent {XExtras.ev_window = window} = do
let screens = getScreens dispvar
(windows, windowStates, icons, windowScreens) <- get
when (elem window windows) $ withDisplay dispvar $ \disp -> do
let screen = M.lookup window windowScreens
screen' <- liftIO $ getWindowScreen disp screens window
when (screen /= (Just screen')) $ do
let windowScreens' = M.insert window screen' windowScreens
sendMessage phi $ WindowListUpdate windows windowStates icons windowScreens'
sendMessage phi Repaint
put (windows, windowStates, icons, windowScreens')
handleEvent _ _ _ = return ()
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 :: 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
@ -357,21 +377,24 @@ 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 -> Atoms -> [Window] -> M.Map Window WindowState -> M.Map Window [(Int, Surface)]
-> IO ([Window], M.Map Window WindowState, M.Map Window [(Int, Surface)])
getWindowStates disp atoms oldWindows windowStates windowIcons = do
getWindowStates :: Xlib.Display -> [Xlib.Rectangle] -> Atoms -> [Window] -> M.Map Window WindowState -> M.Map Window [(Int, Surface)] -> M.Map Window Xlib.Rectangle
-> IO ([Window], M.Map Window WindowState, M.Map Window [(Int, Surface)], M.Map Window Xlib.Rectangle)
getWindowStates disp screens atoms oldWindows windowStates windowIcons windowScreens = do
windows <- getWindowList disp atoms oldWindows
let windowStates' = map (\w -> (w, M.lookup w windowStates)) windows
windowIcons' = map (\w -> (w, M.lookup w windowIcons)) windows
windowScreens' = map (\w -> (w, M.lookup w windowScreens)) windows
newWindowStates <- mapM getWindowState' windowStates'
newWindowIcons <- mapM getWindowIcons' windowIcons'
newWindowScreens <- mapM getWindowScreen' windowScreens'
return (windows, M.fromList newWindowStates, M.fromList newWindowIcons)
return (windows, M.fromList newWindowStates, M.fromList newWindowIcons, M.fromList newWindowScreens)
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
return (window, windowState)
@ -379,10 +402,15 @@ getWindowStates disp atoms oldWindows windowStates windowIcons = do
getWindowIcons' (window, Nothing) = do
icons <- getWindowIcons disp atoms window
return (window, icons)
getWindowScreen' (window, Just screen) = return (window, screen)
getWindowScreen' (window, Nothing) = do
screen <- getWindowScreen disp screens window
return (window, screen)
getWindowState :: Xlib.Display -> Atoms -> Window -> IO WindowState
getWindowState disp atoms window = do
Xlib.selectInput disp window Xlib.propertyChangeMask
netwmname <- liftM (fmap (decode . map fromIntegral)) $ XExtras.getWindowProperty8 disp (atom_NET_WM_NAME atoms) window
wmname <- case netwmname of
Just name -> return name
@ -399,6 +427,7 @@ getWindowState disp atoms window = do
getWindowIcons :: Xlib.Display -> Atoms -> Window -> IO [(Int, Surface)]
getWindowIcons disp atoms window = XExtras.getWindowProperty32 disp (atom_NET_WM_ICON atoms) window >>= readIcons . fromMaybe []
readIcons :: [CLong] -> IO [(Int, Surface)]
readIcons (width:height:iconData) = do
if ((fromIntegral $ length iconData) < (width*height)) then return [] else do
@ -429,6 +458,21 @@ premultiply c = a .|. r .|. g .|. b
g = pm gmask
b = pm bmask
getWindowScreen :: Xlib.Display -> [Xlib.Rectangle] -> Window -> IO Xlib.Rectangle
getWindowScreen disp screens window = 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
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