summaryrefslogtreecommitdiffstats
path: root/lib/Phi/Widgets
diff options
context:
space:
mode:
authorMatthias Schiffer <mschiffer@universe-factory.net>2011-09-08 19:15:23 +0200
committerMatthias Schiffer <mschiffer@universe-factory.net>2011-09-08 19:15:23 +0200
commit4d519acbd48fa400f09e4705251a0dbf45c6876e (patch)
treedd9577b92028f35899507fc45c652a6fd50b4c44 /lib/Phi/Widgets
parent234388ef387c92cc72f35cb309b9d0beea8d3a1a (diff)
downloadphi-4d519acbd48fa400f09e4705251a0dbf45c6876e.tar
phi-4d519acbd48fa400f09e4705251a0dbf45c6876e.zip
Core is independent of X11 now
Diffstat (limited to 'lib/Phi/Widgets')
-rw-r--r--lib/Phi/Widgets/AlphaBox.hs8
-rw-r--r--lib/Phi/Widgets/Clock.hs8
-rw-r--r--lib/Phi/Widgets/X11/Systray.hs (renamed from lib/Phi/Widgets/Systray.hs)4
-rw-r--r--lib/Phi/Widgets/X11/Taskbar.hs (renamed from lib/Phi/Widgets/Taskbar.hs)156
4 files changed, 92 insertions, 84 deletions
diff --git a/lib/Phi/Widgets/AlphaBox.hs b/lib/Phi/Widgets/AlphaBox.hs
index 6f989ea..59f8aea 100644
--- a/lib/Phi/Widgets/AlphaBox.hs
+++ b/lib/Phi/Widgets/AlphaBox.hs
@@ -13,11 +13,11 @@ import Control.Monad.State.Strict
import Graphics.Rendering.Cairo
-data AlphaBox w s c = (Widget w s c) => AlphaBox !Double !w
+data AlphaBox w s c d = (Widget w s c d) => AlphaBox !Double !w
-data AlphaBoxCache w s c = (Widget w s c) => AlphaBoxCache !c
+data AlphaBoxCache w s c d = (Widget w s c d) => AlphaBoxCache !c
-instance Eq s => Widget (AlphaBox w s c) s (AlphaBoxCache w s c) where
+instance (Eq s, Display d) => Widget (AlphaBox w s c d) s (AlphaBoxCache w s c d) d where
initWidget (AlphaBox _ w) = initWidget w
initCache (AlphaBox _ w) = AlphaBoxCache $ initCache w
@@ -47,6 +47,6 @@ instance Eq s => Widget (AlphaBox w s c) s (AlphaBoxCache w s c) where
handleMessage (AlphaBox _ w) = handleMessage w
-alphaBox :: (Widget w s c) => Double -> w -> AlphaBox w s c
+alphaBox :: (Widget w s c d) => Double -> w -> AlphaBox w s c d
alphaBox = AlphaBox
diff --git a/lib/Phi/Widgets/Clock.hs b/lib/Phi/Widgets/Clock.hs
index 9282432..26b777f 100644
--- a/lib/Phi/Widgets/Clock.hs
+++ b/lib/Phi/Widgets/Clock.hs
@@ -34,7 +34,7 @@ data ClockConfig = ClockConfig { clockFormat :: !String
defaultClockConfig :: ClockConfig
defaultClockConfig = ClockConfig "%R" (0, 0, 0, 1) 0 50
-data Clock = Clock !ClockConfig deriving (Show, Eq)
+data Clock d = Clock !ClockConfig deriving (Show, Eq)
deriving instance Eq ZonedTime
@@ -42,7 +42,7 @@ data ClockState = ClockState !ZonedTime deriving (Show, Eq)
data ClockMessage = UpdateTime !ZonedTime deriving (Show, Typeable)
-instance Widget Clock ClockState (RenderCache ClockState) where
+instance Display d => Widget (Clock d) ClockState (RenderCache ClockState) d where
initWidget (Clock _) phi _ _ = do
forkIO $ forever $ do
time <- getZonedTime
@@ -85,6 +85,6 @@ instance Widget Clock ClockState (RenderCache ClockState) where
_ -> priv
-clock :: ClockConfig -> Clock
+clock :: ClockConfig -> Clock d
clock config = do
- Clock config \ No newline at end of file
+ Clock config
diff --git a/lib/Phi/Widgets/Systray.hs b/lib/Phi/Widgets/X11/Systray.hs
index 27a5e34..fffb181 100644
--- a/lib/Phi/Widgets/Systray.hs
+++ b/lib/Phi/Widgets/X11/Systray.hs
@@ -1,7 +1,7 @@
{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances #-}
-module Phi.Widgets.Systray ( systray
- ) where
+module Phi.Widgets.X11.Systray ( systray
+ ) where
import Control.Concurrent
import Control.Monad
diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/X11/Taskbar.hs
index f0a8196..07a7292 100644
--- a/lib/Phi/Widgets/Taskbar.hs
+++ b/lib/Phi/Widgets/X11/Taskbar.hs
@@ -1,15 +1,15 @@
{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances #-}
-module Phi.Widgets.Taskbar ( IconStyle
- , idIconStyle
- , desaturateIconStyle
- , TaskStyle(..)
- , DesktopStyle(..)
- , TaskbarConfig(..)
- , defaultTaskbarConfig
- , Taskbar
- , taskbar
- ) where
+module Phi.Widgets.X11.Taskbar ( IconStyle
+ , idIconStyle
+ , desaturateIconStyle
+ , TaskStyle(..)
+ , DesktopStyle(..)
+ , TaskbarConfig(..)
+ , defaultTaskbarConfig
+ , Taskbar
+ , taskbar
+ ) where
import Control.Arrow
import Control.Concurrent
@@ -48,6 +48,7 @@ import Phi.Phi
import Phi.Types
import Phi.Border
import Phi.Widget
+import Phi.X11
import Phi.X11.Atoms
import Phi.X11.Util
@@ -138,7 +139,7 @@ defaultTaskbarConfig = TaskbarConfig { taskMaxSize = 200
data Taskbar = Taskbar TaskbarConfig
-data TaskbarState = TaskbarState { taskbarScreens :: ![RECTANGLE]
+data TaskbarState = TaskbarState { taskbarScreens :: ![Rectangle]
, taskbarActiveWindow :: !WINDOW
, taskbarDesktopCount :: !Int
, taskbarCurrentDesktop :: !Int
@@ -161,7 +162,7 @@ data WindowState = WindowState { windowTitle :: !String
, windowDesktop :: !Int
, windowVisible :: !Bool
, windowIcons :: ![Icon]
- , windowGeometry :: !RECTANGLE
+ , windowGeometry :: !Rectangle
} deriving (Eq, Show)
data WindowCache = WindowCache { createScaledIconCached :: !(IOCache ([Icon], Int) (Maybe Icon))
@@ -208,7 +209,7 @@ data TaskbarMessage = WindowListUpdate ![WINDOW] !(M.Map WINDOW WindowState)
| ActiveWindowUpdate !WINDOW
deriving (Typeable, Show)
-instance Widget Taskbar TaskbarState (M.Map WINDOW WindowCache) where
+instance Widget Taskbar TaskbarState (M.Map WINDOW WindowCache) X11 where
initWidget (Taskbar _) phi dispvar screens = do
phi' <- dupPhi phi
forkIO $ taskbarRunner phi' dispvar
@@ -398,14 +399,14 @@ windowOnDesktop :: Int -> WindowState -> Bool
windowOnDesktop desktop state = (windowVisible state) && (desktop == windowDesktop state)
-taskbarRunner :: Phi -> Display -> IO ()
-taskbarRunner phi dispvar = do
- (windows, states) <- liftIO $ withDisplay dispvar $ \disp -> do
- (windows, states) <- getWindowStates disp (getAtoms dispvar) M.empty
- desktopCount <- getDesktopCount disp (getAtoms dispvar)
- current <- getCurrentDesktop disp (getAtoms dispvar)
- names <- getDesktopNames disp (getAtoms dispvar)
- activeWindow <- getActiveWindow disp (getAtoms dispvar)
+taskbarRunner :: Phi -> X11 -> IO ()
+taskbarRunner phi x11 = do
+ (windows, states) <- liftIO $ do
+ (windows, states) <- getWindowStates x11 M.empty
+ desktopCount <- getDesktopCount x11
+ current <- getCurrentDesktop x11
+ names <- getDesktopNames x11
+ activeWindow <- getActiveWindow x11
sendMessage phi $ WindowListUpdate windows states
sendMessage phi $ DesktopCountUpdate desktopCount
sendMessage phi $ CurrentDesktopUpdate current
@@ -418,23 +419,24 @@ taskbarRunner phi dispvar = do
m <- receiveMessage phi
case (fromMessage m) of
Just (XEvent event) ->
- handleEvent phi dispvar event
+ handleEvent phi x11 event
_ ->
return ()
-handleEvent :: Phi -> Display -> SomeEvent -> StateT ([WINDOW], M.Map WINDOW WindowState) IO ()
-handleEvent phi dispvar event =
+handleEvent :: Phi -> X11 -> SomeEvent -> StateT ([WINDOW], M.Map WINDOW WindowState) IO ()
+handleEvent phi x11 event =
case (fromEvent event) of
- Just e -> handlePropertyNotifyEvent phi dispvar e
+ Just e -> handlePropertyNotifyEvent phi x11 e
Nothing -> case (fromEvent event) of
- Just e -> handleConfigureNotifyEvent phi dispvar e
+ Just e -> handleConfigureNotifyEvent phi x11 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
-
+handlePropertyNotifyEvent :: Phi -> X11 -> PropertyNotifyEvent -> StateT ([WINDOW], M.Map WINDOW WindowState) IO ()
+handlePropertyNotifyEvent phi x11 MkPropertyNotifyEvent {atom_PropertyNotifyEvent = atom, window_PropertyNotifyEvent = window} = do
+ let atoms = x11Atoms x11
+ rootwin = root_SCREEN . x11Screen $ x11
+
when (elem atom $ map ($ atoms) [ atom_NET_ACTIVE_WINDOW
, atom_NET_NUMBER_OF_DESKTOPS
, atom_NET_CURRENT_DESKTOP
@@ -445,29 +447,28 @@ handlePropertyNotifyEvent phi dispvar MkPropertyNotifyEvent {atom_PropertyNotify
, atom_NET_WM_NAME
, atom_NET_WM_DESKTOP
, atom_NET_WM_STATE
- ]) $ withDisplay dispvar $ \conn -> do
- let rootwin = getRoot conn
+ ]) $ do
if (window == rootwin)
then do
when (atom == atom_NET_ACTIVE_WINDOW atoms) $ do
- activeWindow <- liftIO $ getActiveWindow conn atoms
+ activeWindow <- liftIO $ getActiveWindow x11
sendMessage phi $ ActiveWindowUpdate activeWindow
sendMessage phi Repaint
when (atom == atom_NET_NUMBER_OF_DESKTOPS atoms) $ do
- desktopCount <- liftIO $ getDesktopCount conn atoms
+ desktopCount <- liftIO $ getDesktopCount x11
sendMessage phi $ DesktopCountUpdate desktopCount
sendMessage phi Repaint
when (atom == atom_NET_CURRENT_DESKTOP atoms) $ do
- current <- liftIO $ getCurrentDesktop conn atoms
+ current <- liftIO $ getCurrentDesktop x11
sendMessage phi $ CurrentDesktopUpdate current
sendMessage phi Repaint
when (atom == atom_NET_DESKTOP_NAMES atoms) $ do
- names <- liftIO $ getDesktopNames conn atoms
+ names <- liftIO $ getDesktopNames x11
sendMessage phi $ DesktopNamesUpdate names
sendMessage phi Repaint
when (atom == atom_NET_CLIENT_LIST atoms) $ do
(windows, windowStates) <- get
- (windows', windowStates') <- liftIO $ getWindowStates conn atoms windowStates
+ (windows', windowStates') <- liftIO $ getWindowStates x11 windowStates
when (windows /= windows') $ do
sendMessage phi $ WindowListUpdate windows' windowStates'
@@ -479,14 +480,14 @@ handlePropertyNotifyEvent phi dispvar MkPropertyNotifyEvent {atom_PropertyNotify
when (elem window windows) $ do
case () of
_ | (atom == atom_NET_WM_ICON atoms) -> do
- icons <- liftIO $ getWindowIcons conn atoms window
+ icons <- liftIO $ getWindowIcons x11 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 conn atoms window
+ (name, desktop, visible) <- liftIO $ getWindowInfo x11 window
let mwindowState = M.lookup window windowStates
case mwindowState of
Just windowState -> do
@@ -501,12 +502,13 @@ handlePropertyNotifyEvent phi dispvar MkPropertyNotifyEvent {atom_PropertyNotify
return ()
-handleConfigureNotifyEvent :: Phi -> Display -> ConfigureNotifyEvent -> StateT ([WINDOW], M.Map WINDOW WindowState) IO ()
-handleConfigureNotifyEvent phi dispvar MkConfigureNotifyEvent {window_ConfigureNotifyEvent = window} = do
+handleConfigureNotifyEvent :: Phi -> X11 -> ConfigureNotifyEvent -> StateT ([WINDOW], M.Map WINDOW WindowState) IO ()
+handleConfigureNotifyEvent phi x11 MkConfigureNotifyEvent {window_ConfigureNotifyEvent = window} = do
+ let conn = x11Connection x11
(windows, windowStates) <- get
- when (elem window windows) $ withDisplay dispvar $ \conn -> do
+ when (elem window windows) $ do
let geom = fmap windowGeometry . M.lookup window $ windowStates
- geom' <- liftIO $ getWindowGeometry conn window
+ geom' <- liftIO $ getWindowGeometry x11 window
when (geom /= (Just geom')) $ do
let windowStates' = M.update (\state -> Just state {windowGeometry = geom'}) window windowStates
sendMessage phi $ WindowListUpdate windows windowStates'
@@ -514,30 +516,30 @@ handleConfigureNotifyEvent phi dispvar MkConfigureNotifyEvent {window_ConfigureN
put (windows, windowStates')
-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 :: X11 -> IO Int
+getDesktopCount x11 =
+ liftM (fromIntegral . fromMaybe 0 . join . fmap listToMaybe) $ getProperty32 (x11Connection x11) (root_SCREEN . x11Screen $ x11) (atom_NET_NUMBER_OF_DESKTOPS . x11Atoms $ x11)
-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 :: X11 -> IO Int
+getCurrentDesktop x11 =
+ liftM (fromIntegral . fromMaybe (-1) . join . fmap listToMaybe) $ getProperty32 (x11Connection x11) (root_SCREEN . x11Screen $ x11) (atom_NET_CURRENT_DESKTOP . x11Atoms $ x11)
-getDesktopNames :: Connection -> Atoms -> IO [String]
-getDesktopNames conn atoms =
- liftM (map (decode . map fromIntegral) . break' . fromMaybe []) $ getProperty8 conn (getRoot conn) (atom_NET_DESKTOP_NAMES atoms)
+getDesktopNames :: X11 -> IO [String]
+getDesktopNames x11 =
+ liftM (map (decode . map fromIntegral) . break' . fromMaybe []) $ getProperty8 (x11Connection x11) (root_SCREEN . x11Screen $ x11) (atom_NET_DESKTOP_NAMES . x11Atoms $ x11)
where
break' l = case dropWhile (== 0) l of
[] -> []
l' -> w : break' l''
where (w, l'') = break (== 0) l'
-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)
+getActiveWindow :: X11 -> IO WINDOW
+getActiveWindow x11 =
+ liftM (fromXid . toXid . fromMaybe 0 . join . fmap listToMaybe) $ getProperty32 (x11Connection x11) (root_SCREEN . x11Screen $ x11) (atom_NET_ACTIVE_WINDOW . x11Atoms $ x11)
-getWindowStates :: Connection -> Atoms -> M.Map WINDOW WindowState -> IO ([WINDOW], M.Map WINDOW WindowState)
-getWindowStates conn atoms windowStates = do
- windows <- getWindowList conn atoms
+getWindowStates :: X11 -> M.Map WINDOW WindowState -> IO ([WINDOW], M.Map WINDOW WindowState)
+getWindowStates x11 windowStates = do
+ windows <- getWindowList x11
let windowStates' = map (\w -> (w, M.lookup w windowStates)) windows
@@ -547,15 +549,15 @@ getWindowStates conn atoms windowStates = do
where
getWindowState' (window, Just windowState) = return (window, windowState)
getWindowState' (window, Nothing) = do
- changeWindowAttributes conn window $ toValueParam [(CWEventMask, toMask [EventMaskPropertyChange, EventMaskStructureNotify])]
- windowState <- getWindowState conn atoms window
+ changeWindowAttributes (x11Connection x11) window $ toValueParam [(CWEventMask, toMask [EventMaskPropertyChange, EventMaskStructureNotify])]
+ windowState <- getWindowState x11 window
return (window, windowState)
-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
+getWindowState :: X11 -> WINDOW -> IO WindowState
+getWindowState x11 window = do
+ (name, workspace, visible) <- getWindowInfo x11 window
+ icons <- getWindowIcons x11 window
+ geom <- getWindowGeometry x11 window
return $ WindowState { windowTitle = name
, windowDesktop = workspace
@@ -564,8 +566,10 @@ getWindowState conn atoms window = do
, windowGeometry = geom
}
-getWindowInfo :: Connection -> Atoms -> WINDOW -> IO (String, Int, Bool)
-getWindowInfo conn atoms window = do
+getWindowInfo :: X11 -> WINDOW -> IO (String, Int, Bool)
+getWindowInfo x11 window = do
+ let conn = x11Connection x11
+ atoms = x11Atoms x11
netwmname <- liftM (fmap (decode . map fromIntegral)) $ getProperty8 conn window (atom_NET_WM_NAME atoms)
wmname <- case netwmname of
Just name -> return name
@@ -578,8 +582,8 @@ getWindowInfo conn atoms window = do
where
unsignedChr = chr . fromIntegral
-getWindowIcons :: Connection -> Atoms -> WINDOW -> IO [Icon]
-getWindowIcons conn atoms window = getProperty32 conn window (atom_NET_WM_ICON atoms) >>= readIcons . fromMaybe []
+getWindowIcons :: X11 -> WINDOW -> IO [Icon]
+getWindowIcons x11 window = getProperty32 (x11Connection x11) window (atom_NET_WM_ICON . x11Atoms $ x11) >>= readIcons . fromMaybe []
readIcons :: [Word32] -> IO [Icon]
@@ -612,9 +616,13 @@ premultiply c = a .|. r .|. g .|. b
b = pm bmask
-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))
+getWindowGeometry :: X11 -> WINDOW -> IO Rectangle
+getWindowGeometry x11 window =
+ getGeometry (x11Connection x11) (fromXid . toXid $ window) >>= getReply >>=
+ return . ((const $ Rectangle 0 0 0 0) ||| (\(MkGetGeometryReply _ _ x y width height _) -> Rectangle (fi x) (fi y) (fi width) (fi height)))
+ where
+ fi :: (Integral a, Num b) => a -> b
+ fi = fromIntegral
showWindow :: Connection -> Atoms -> WINDOW -> IO Bool
showWindow conn atoms window = do
@@ -634,8 +642,8 @@ showWindow conn atoms window = do
]
-getWindowList :: Connection -> Atoms -> IO [WINDOW]
-getWindowList conn atoms = liftM (map (fromXid . toXid) . join . maybeToList) $ getProperty32 conn (getRoot conn) (atom_NET_CLIENT_LIST atoms)
+getWindowList :: X11 -> IO [WINDOW]
+getWindowList x11 = liftM (map (fromXid . toXid) . join . maybeToList) $ getProperty32 (x11Connection x11) (root_SCREEN . x11Screen $ x11) (atom_NET_CLIENT_LIST . x11Atoms $ x11)
taskbar :: TaskbarConfig -> Taskbar
taskbar = Taskbar