summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lib/Phi/Border.hs4
-rw-r--r--lib/Phi/Widget.hs50
-rw-r--r--lib/Phi/Widgets/Clock.hs2
-rw-r--r--lib/Phi/Widgets/Taskbar.hs214
-rw-r--r--lib/Phi/X11.hs4
-rw-r--r--src/Phi.hs11
6 files changed, 175 insertions, 110 deletions
diff --git a/lib/Phi/Border.hs b/lib/Phi/Border.hs
index 7de66ea..791845d 100644
--- a/lib/Phi/Border.hs
+++ b/lib/Phi/Border.hs
@@ -79,10 +79,10 @@ instance WidgetClass Border where
width' = width - borderH m - 2*bw - borderH p
height' = height - borderV m - 2*bw - borderV p
- render (Border config _) (BorderState widgetStates) w h = do
+ render (Border config _) (BorderState widgetStates) w h screen = do
drawBorder config 0 0 w h
clip
- renderWidgets widgetStates
+ renderWidgets widgetStates screen
handleMessage _ (BorderState widgetStates) m = BorderState $ handleMessageWidgets m widgetStates
diff --git a/lib/Phi/Widget.hs b/lib/Phi/Widget.hs
index 218dea1..48ab536 100644
--- a/lib/Phi/Widget.hs
+++ b/lib/Phi/Widget.hs
@@ -3,6 +3,8 @@
module Phi.Widget ( Display(..)
, withDisplay
, getAtoms
+ , getScreens
+ , unionArea
, Widget(..)
, WidgetClass(..)
, WidgetState(..)
@@ -19,24 +21,42 @@ import Control.Monad.IO.Class
import Data.Traversable
-import qualified Graphics.X11.Xlib
+import qualified Graphics.X11.Xlib as Xlib
import Graphics.Rendering.Cairo
import Phi.Phi
import Phi.X11.Atoms
-data Display = Display (MVar Graphics.X11.Xlib.Display) Atoms
+data Display = Display (MVar Xlib.Display) Atoms [Xlib.Rectangle]
-withDisplay :: MonadIO m => Display -> (Graphics.X11.Xlib.Display -> m a) -> m a
-withDisplay (Display dispvar _) f = do
+withDisplay :: MonadIO m => Display -> (Xlib.Display -> m a) -> m a
+withDisplay (Display dispvar _ _) f = do
disp <- liftIO $ takeMVar dispvar
a <- f disp
liftIO $ putMVar dispvar disp
return a
getAtoms :: Display -> Atoms
-getAtoms (Display _ atoms) = atoms
+getAtoms (Display _ atoms _) = atoms
+
+getScreens :: Display -> [Xlib.Rectangle]
+getScreens (Display _ _ screens) = screens
+
+unionArea :: Xlib.Rectangle -> Xlib.Rectangle -> Int
+unionArea a b = fromIntegral $ uw*uh
+ where
+ uw = max 0 $ (min ax2 bx2) - (max ax1 bx1)
+ uh = max 0 $ (min ay2 by2) - (max ay1 by1)
+
+ Xlib.Rectangle ax1 ay1 aw ah = a
+ Xlib.Rectangle bx1 by1 bw bh = b
+
+ ax2 = ax1 + fromIntegral aw
+ ay2 = ay1 + fromIntegral ah
+
+ bx2 = bx1 + fromIntegral bw
+ by2 = by1 + fromIntegral bh
class Show a => WidgetClass a where
@@ -52,7 +72,7 @@ class Show a => WidgetClass a where
layout :: a -> WidgetData a -> Int -> Int -> WidgetData a
layout _ priv _ _ = priv
- render :: a -> WidgetData a -> Int -> Int -> Render ()
+ render :: a -> WidgetData a -> Int -> Int -> Xlib.Rectangle -> Render ()
handleMessage :: a -> WidgetData a -> Message -> WidgetData a
handleMessage _ priv _ = priv
@@ -102,16 +122,16 @@ layoutWidgets widgets x y width height = snd $ mapAccumL layoutWidgetAndX x widg
nneg :: (Num a, Ord a) => a -> a
nneg x = max 0 x
-renderWidgets :: [WidgetState] -> Render ()
-renderWidgets widgets = forM_ widgets $ \WidgetState { stateWidget = widget
- , stateX = x
- , stateY = y
- , stateWidth = w
- , stateHeight = h
- , statePrivateData = priv } -> do
+renderWidgets :: [WidgetState] -> Xlib.Rectangle -> Render ()
+renderWidgets widgets screen = forM_ widgets $ \WidgetState { stateWidget = widget
+ , stateX = x
+ , stateY = y
+ , stateWidth = w
+ , stateHeight = h
+ , statePrivateData = priv } -> do
save
translate (fromIntegral x) (fromIntegral y)
- render widget priv w h
+ render widget priv w h screen
restore
handleMessageWidgets :: Message -> [WidgetState] -> [WidgetState]
@@ -127,7 +147,7 @@ instance WidgetClass Separator where
minSize (Separator s _) = s
weight (Separator _ w) = w
- render _ _ _ _ = return ()
+ render _ _ _ _ _ = return ()
separator :: Int -> Float -> Widget
separator s w = Widget $ Separator s w
diff --git a/lib/Phi/Widgets/Clock.hs b/lib/Phi/Widgets/Clock.hs
index 3e88b0e..7172f77 100644
--- a/lib/Phi/Widgets/Clock.hs
+++ b/lib/Phi/Widgets/Clock.hs
@@ -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
diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs
index 4377224..caa7599 100644
--- a/lib/Phi/Widgets/Taskbar.hs
+++ b/lib/Phi/Widgets/Taskbar.hs
@@ -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
+
+ 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 ()
- flip (flip foldM_ 0) desktops $ \nwindows (desktop, desktopWindows) -> do
- let dstyle' = dstyle desktop
- dx = dleftwidth desktop + (sum $ map dwidth $ take desktop [0..]) + nwindows*windowWidth
+ 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
diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs
index 709d04a..24f0986 100644
--- a/lib/Phi/X11.hs
+++ b/lib/Phi/X11.hs
@@ -86,7 +86,7 @@ runPhi xconfig config widgets = do
screens <- liftIO $ phiXScreenInfo xconfig disp
dispmvar <- liftIO $ newMVar disp
- let dispvar = Widget.Display dispmvar atoms
+ let dispvar = Widget.Display dispmvar atoms screens
widgetStates <- liftIO $ mapM (Widget.createWidgetState phi dispvar) widgets
Widget.withDisplay dispvar $ \disp -> do
@@ -172,7 +172,7 @@ updatePanels disp redraw = do
setSource pattern
paint
restore
- Widget.renderWidgets layoutedWidgets
+ Widget.renderWidgets layoutedWidgets $ panelScreenArea panel
return panel'
diff --git a/src/Phi.hs b/src/Phi.hs
index 417d8f8..ea35633 100644
--- a/src/Phi.hs
+++ b/src/Phi.hs
@@ -12,15 +12,16 @@ main = do
runPhi defaultXConfig defaultPanelConfig { panelPosition = Bottom }
[theTaskbar, brightBorder [theClock]]
where
- normalTaskBorder = BorderConfig (BorderWidth 2 (-4) 2 7) 1 (BorderWidth 0 5 0 5) (0.9, 0.9, 0.9, 0.65) (0.45, 0.45, 0.45, 0.8) 5 0
- activeTaskBorder = normalTaskBorder {borderColor = (1, 1, 1, 0.65), backgroundColor = (0, 0, 0, 0.8)}
+ normalTaskBorder = BorderConfig (BorderWidth 2 (-3) 2 7) 1 (BorderWidth 0 5 0 5) (0.9, 0.9, 0.9, 0.8) (0.45, 0.45, 0.45, 1) 5 0
+ activeTaskBorder = normalTaskBorder { borderColor = (1, 1, 1, 0.8)
+ , backgroundColor = (0, 0, 0, 1)
+ }
normalDesktopBorder = normalTaskBorder { margin = BorderWidth 2 3 2 3
, padding = BorderWidth 0 2 0 2
- , borderColor = (0.75, 0.75, 0.75, 0.5)
+ , borderColor = (0.7, 0.7, 0.7, 0.8)
, backgroundColor = (1, 1, 1, 0.8)
}
- currentDesktopBorder = normalDesktopBorder { borderColor = (0.75, 0.75, 0.75, 0.8)
- , backgroundColor = (0.2, 0.2, 0.2, 0.9)
+ currentDesktopBorder = normalDesktopBorder { backgroundColor = (0.2, 0.2, 0.2, 0.8)
}
taskStyle = TaskStyle { taskFont = "Sans 7"
, taskColor = (1, 1, 1, 1)