Core is independent of X11 now

1 files changed, 0 insertions, 641 deletions

diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs
deleted file mode 100644
index f0a8196..0000000
--- a/lib/Phi/Widgets/Taskbar.hs
+++ /dev/null
@@ -1,641 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances #-}
-
-module Phi.Widgets.Taskbar ( IconStyle
-                           , idIconStyle
-                           , desaturateIconStyle
-                           , TaskStyle(..)
-                           , DesktopStyle(..)
-                           , TaskbarConfig(..)
-                           , defaultTaskbarConfig
-                           , Taskbar
-                           , taskbar
-                           ) where
-
-import Control.Arrow
-import Control.Concurrent
-import Control.Monad
-import Control.Monad.State.Strict
-import Control.Monad.Trans
-
-import Data.Array.MArray
-import Data.Bits
-import Data.Char
-import Data.Function
-import Data.IORef
-import Data.List
-import Data.Maybe
-import Data.Typeable
-import Data.Unique
-import Data.Word
-import qualified Data.Accessor.Basic as A
-import qualified Data.Accessor.Container as AC
-import qualified Data.Map as M
-
-import Foreign.C.Types
-
-import Graphics.Rendering.Cairo
-import Graphics.Rendering.Pango.Cairo
-import Graphics.Rendering.Pango.Enums (PangoRectangle(..))
-import Graphics.Rendering.Pango.Layout
-import Graphics.Rendering.Pango.Font
-
-import Graphics.XHB
-import Graphics.XHB.Gen.Xproto
-
-import Codec.Binary.UTF8.String
-
-import Phi.Phi
-import Phi.Types
-import Phi.Border
-import Phi.Widget
-import Phi.X11.Atoms
-import Phi.X11.Util
-
-
-newtype IconStyle = IconStyle { withIconStyle :: Surface -> Render () }
-instance Eq IconStyle where
-  _ == _ = True
-
-idIconStyle :: IconStyle
-idIconStyle = IconStyle $ flip withPatternForSurface setSource
-
-desaturateIconStyle :: Double -> IconStyle
-desaturateIconStyle v = IconStyle $ \icon -> do
-  w <- imageSurfaceGetWidth icon
-  h <- imageSurfaceGetHeight icon
-  
-  renderWithSimilarSurface ContentColorAlpha w h $ \surface -> do
-    renderWith surface $ do
-      setOperator OperatorAdd
-      withPatternForSurface icon setSource
-      paint
-      
-      setSourceRGB 0 0 0
-      paint
-      
-      setOperator OperatorHslSaturation
-      setSourceRGBA 0 0 0 (1-v)
-      paint
-      
-      setOperator OperatorDestIn
-      withPatternForSurface icon setSource
-      paint
-    
-    withPatternForSurface surface setSource
-
-
-downscaled :: Double -> Surface -> Render ()
-downscaled s surface = do
-  case True of
-    _ | s < 0.5 -> do
-      w <- imageSurfaceGetWidth surface
-      h <- imageSurfaceGetHeight surface
-      
-      renderWithSimilarSurface ContentColorAlpha (ceiling (fromIntegral w*s)) (ceiling (fromIntegral h*s)) $ \surface' -> do
-        renderWith surface' $ do
-          scale 0.5 0.5
-          downscaled (2*s) surface
-          paint
-        withPatternForSurface surface' setSource
-      
-      | otherwise -> do
-      scale s s
-      withPatternForSurface surface setSource
-
-
-data TaskStyle = TaskStyle { taskFont      :: !String
-                           , taskColor     :: !Color
-                           , taskBorder    :: !BorderConfig
-                           , taskIconStyle :: !IconStyle
-                           } deriving Eq
-
-data DesktopStyle = DesktopStyle { desktopFont       :: !String
-                                 , desktopLabelWidth :: !Int
-                                 , desktopLabelGap   :: !Int
-                                 , desktopColor      :: !Color
-                                 , desktopBorder     :: !BorderConfig
-                                 }
-
-data TaskbarConfig = TaskbarConfig { taskMaxSize      :: !Int
-                                   , normalTaskStyle  :: !TaskStyle
-                                   , activeTaskStyle  :: !TaskStyle
-                                   , desktopStyle     :: !(Maybe (DesktopStyle, DesktopStyle))
-                                   }
-
-defaultStyle :: TaskStyle
-defaultStyle = TaskStyle { taskFont = "Sans 8"
-                         , taskColor = (0, 0, 0, 1)
-                         , taskBorder = defaultBorderConfig { backgroundColor = (0.75, 0.75, 0.75, 1) }
-                         , taskIconStyle = idIconStyle
-                         }
-
-defaultTaskbarConfig :: TaskbarConfig
-defaultTaskbarConfig = TaskbarConfig { taskMaxSize = 200
-                                     , normalTaskStyle = defaultStyle
-                                     , activeTaskStyle = defaultStyle {taskBorder = defaultBorderConfig { borderColor = (1, 1, 1, 1) }}
-                                     , desktopStyle = Nothing
-                                     }
-
-data Taskbar = Taskbar TaskbarConfig
-
-data TaskbarState = TaskbarState { taskbarScreens           :: ![RECTANGLE]
-                                 , taskbarActiveWindow      :: !WINDOW
-                                 , taskbarDesktopCount      :: !Int
-                                 , taskbarCurrentDesktop    :: !Int
-                                 , taskbarDesktopNames      :: ![String]
-                                 , taskbarWindows           :: ![WINDOW]
-                                 , taskbarWindowStates      :: !(M.Map WINDOW WindowState)
-                                 } deriving Eq
-
-data Icon = Icon !Unique !Int !Surface
-instance Eq Icon where (Icon a _ _) == (Icon b _ _) = a == b
-instance Show Icon where show (Icon _ size _) = "Icon { size = " ++ (show size) ++ " }"
-
-createIcon :: Int -> Surface -> IO Icon
-createIcon size surface = do
-  id <- newUnique
-  return $ Icon id size surface
-
-
-data WindowState = WindowState { windowTitle    :: !String
-                               , windowDesktop  :: !Int
-                               , windowVisible  :: !Bool
-                               , windowIcons    :: ![Icon]
-                               , windowGeometry :: !RECTANGLE
-                               } deriving (Eq, Show)
-
-data WindowCache = WindowCache { createScaledIconCached :: !(IOCache ([Icon], Int) (Maybe Icon))
-                               , renderWindowCached     :: !(IOCache (String, Maybe Icon, TaskStyle, Int, Int) Surface)
-                               }
-
-createScaledIconCached' = A.fromSetGet (\a cache -> cache {createScaledIconCached = a}) createScaledIconCached
-renderWindowCached' = A.fromSetGet (\a cache -> cache {renderWindowCached = a}) renderWindowCached
-
-
-newtype DesktopCache = DesktopCache (IOCache () ())
-
-emptyWindowCache :: WindowCache
-emptyWindowCache = WindowCache { createScaledIconCached = createIOCache createScaledIcon
-                               , renderWindowCached     = createIOCache doRenderWindow
-                               }
-
-data TaskbarCache = TaskbarCache { desktopCaches :: !(M.Map Int DesktopCache)
-                                 , windowCaches  :: !(M.Map WINDOW WindowCache)
-                                 }
-
--- substitute for the liftT function in Data.Accessor.MonadState that uses the strict StateT variant
-liftT :: (Monad m) => A.T r s -> StateT s m a -> StateT r m a
-liftT f m = do
-  s0 <- gets $ A.get f
-  (a,s1) <- lift $ runStateT m s0
-  modify $ A.set f s1
-  return a
-
-liftIOStateT :: (MonadIO m) => StateT s IO a -> StateT s m a
-liftIOStateT m = do 
-  s0 <- get
-  (a,s1) <- liftIO $ runStateT m s0
-  put s1
-  return a
-
-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 ![WINDOW] !(M.Map WINDOW WindowState)
-                    | DesktopCountUpdate !Int
-                    | CurrentDesktopUpdate !Int
-                    | DesktopNamesUpdate ![String]
-                    | ActiveWindowUpdate !WINDOW
-                    deriving (Typeable, Show)
-
-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) (fromXid xidNone) 0 (-1) [] [] M.empty
-  
-  initCache _ = M.empty
-    
-  minSize _ _ _ _ = 0
-  weight _ = 1
-  
-  render (Taskbar config) TaskbarState { taskbarScreens = screens
-                                       , taskbarActiveWindow = activeWindow
-                                       , taskbarDesktopCount = desktopCount
-                                       , taskbarCurrentDesktop = currentDesktop
-                                       , taskbarDesktopNames = desktopNames
-                                       , taskbarWindows = windows
-                                       , taskbarWindowStates = windowStates
-                                       } _ _ w h screen = do
-    let windowScreen w = maximumBy (compare `on` unionArea (windowGeometry w)) screens
-        screenWindows  = filter ((== Just screen) . fmap windowScreen . flip M.lookup windowStates) windows
-        desktopNumbers = take desktopCount $ zip [0..] (desktopNames ++ repeat "")
-        desktops       = map (\desktop -> (desktop, filter (fromMaybe False . fmap (windowOnDesktop . fst $ 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
-        gap d ds       = if null (snd $ desktops !! d) then 0 else desktopLabelGap ds
-        dleftwidth d   = fromMaybe 0 $ fmap (\ds@DesktopStyle {desktopBorder = border}
-                                             -> (borderLeft $ margin border) + (borderWidth border) + (borderLeft $ padding border)
-                                                + dlabelwidth d + gap d ds) $ dstyle d
-        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
-        
-        desktopsWidth  = sum $ map (dwidth . fst) desktopNumbers
-        windowWidth    = if windowCount == 0 then 0 else min (taskMaxSize config) ((w - desktopsWidth) `div` windowCount)
-    
-    surface <- liftIO $ createImageSurface FormatARGB32 w h
-    cache <- liftM (M.filterWithKey $ \w _ -> elem w windows) get
-    cache' <- renderWith surface $ flip execStateT cache $ do
-      lift $ do
-        setOperator OperatorClear
-        paint
-        
-        setOperator OperatorOver
-      
-      flip (flip foldM_ 0) desktops $ \nwindows (desktop, desktopWindows) -> do
-        let dstyle' = dstyle (fst desktop)
-            dx = dleftwidth (fst desktop) + (sum $ map dwidth $ take (fst desktop) [0..]) + nwindows*windowWidth
-        
-        case dstyle' of
-          Just ds -> do
-            let (r, g, b, a) = desktopColor ds
-            lift $ do
-              save
-              drawBorder (desktopBorder ds) (dx - dleftwidth (fst desktop)) 0 (dwidth (fst desktop) + windowWidth * length desktopWindows) h
-              clip
-              
-              setSourceRGBA r g b a
-              renderText (desktopFont ds) (fromIntegral (dx - dlabelwidth (fst desktop) - gap (fst desktop) ds)) 0 (dlabelwidth (fst desktop)) h $ snd desktop
-              
-              restore
-            
-            forM_ (zip [0..] desktopWindows) $ \(i, window) -> do
-              let style = (if window == activeWindow then activeTaskStyle else normalTaskStyle) config
-                  h' = h - (borderV $ margin $ desktopBorder ds) - 2*(borderWidth $ desktopBorder ds) - (borderV $ padding $ desktopBorder ds)
-                  mstate = M.lookup window windowStates
-                  x = dx + i*windowWidth
-                  y = (borderTop $ margin $ desktopBorder ds) + (borderWidth $ desktopBorder ds) + (borderTop $ padding $ desktopBorder ds)
-              
-              case mstate of
-                Just state -> do
-                  windowSurface <- liftT (AC.mapDefault emptyWindowCache window) . liftIOStateT $ renderWindow state style windowWidth h'
-                  lift $ do
-                    save
-                    translate (fromIntegral $ x - 5) (fromIntegral $ y - 5)
-                    withPatternForSurface windowSurface setSource
-                    paint
-                    restore
-            
-                Nothing -> return ()
-        
-          _ -> return ()
-      
-        return $ nwindows + length desktopWindows
-    put cache'
-    
-    return [(True, SurfaceSlice 0 surface)]
-      
-  
-  handleMessage _ priv m = case (fromMessage m) of
-    Just (WindowListUpdate windows windowStates) -> priv { taskbarWindows = windows
-                                                         , taskbarWindowStates = windowStates
-                                                         }
-    Just (DesktopCountUpdate count) -> priv {taskbarDesktopCount = count}
-    Just (CurrentDesktopUpdate current) -> priv {taskbarCurrentDesktop = current}
-    Just (DesktopNamesUpdate names) -> priv {taskbarDesktopNames = names}
-    Just (ActiveWindowUpdate window) -> priv {taskbarActiveWindow = window}
-    _ -> case (fromMessage m) of
-      Just (UpdateScreens screens) -> priv {taskbarScreens = map fst screens}
-      _ -> priv
-
-
-renderText :: String -> Int -> Int -> Int -> Int -> String -> Render ()
-renderText font x y w h text = do
-  layout <- createLayout ""
-  (_, PangoRectangle _ _ textWidth textHeight) <- liftIO $ do
-    layoutSetMarkup layout $ "<span font='" ++ font ++ "'>" ++ (escapeMarkup text) ++ "</span>"
-    layoutSetWidth layout $ Just $ fromIntegral w
-    layoutSetEllipsize layout EllipsizeEnd
-    
-    layoutGetExtents layout
-  
-  
-  moveTo ((fromIntegral x) + ((fromIntegral w) - textWidth)/2) ((fromIntegral y) + ((fromIntegral h) - textHeight)/2)
-  showLayout layout
-
-renderWindow :: WindowState -> TaskStyle -> Int -> Int -> StateT WindowCache IO Surface
-renderWindow state style w h = do
-  let h' = h - (borderV $ margin $ taskBorder style)
-  
-  scaledIcon <- cached createScaledIconCached' (windowIcons state, h')
-  cached renderWindowCached' (windowTitle state, scaledIcon, style, w, h)
-
-doRenderWindow :: (String, Maybe Icon, TaskStyle, Int, Int) -> IO Surface
-doRenderWindow (title, scaledIcon, style, w, h) = do
-  let (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)
-  
-  surface <- createImageSurface FormatARGB32 (w+10) (h+10)
-  renderWith surface $ do
-    translate 5 5
-    
-    save
-    drawBorder (taskBorder style) 0 0 w h
-    clip
-    
-    setSourceRGBA r g b a
-    renderText (taskFont style) (fromIntegral (leftBorder + h' + 3)) 0 (w - leftBorder - h' - 3 - rightBorder) h title
-    
-    restore
-    
-    case scaledIcon of
-      Just (Icon _ _ icon) -> do
-        save
-        translate (fromIntegral leftBorder) (fromIntegral . borderTop . margin . taskBorder $ style)
-        withIconStyle (taskIconStyle style) icon
-        paint
-        restore
-    
-      _ -> return ()
-  
-  return surface
-                
-
-createScaledIcon :: ([Icon], Int) -> IO (Maybe Icon)
-createScaledIcon (icons, h) = do
-  case bestIcon of
-    Just (Icon _ _ icon) -> do
-      scaledIcon <- createSimilarSurface icon ContentColorAlpha h h
-      renderWith scaledIcon $ do
-        imageW <- imageSurfaceGetWidth icon
-        imageH <- imageSurfaceGetHeight icon
-        
-        let scalef = (fromIntegral h)/(fromIntegral $ max imageW imageH)
-        
-        case () of
-          _ | imageH < imageW -> translate 0 (fromIntegral (imageW-imageH)*scalef/2)
-            | otherwise -> translate (fromIntegral (imageH-imageW)*scalef/2) 0
-        
-        downscaled scalef icon
-        paint
-      fmap Just $ createIcon h scaledIcon
-          
-    _ -> return Nothing
-  
-  where
-    bestIcon = listToMaybe $ sortBy compareIcons icons
-    compareIcons = flip (compare `on` (\(Icon _ size _) -> size))
-
-
-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) 
-    sendMessage phi $ WindowListUpdate windows states
-    sendMessage phi $ DesktopCountUpdate desktopCount
-    sendMessage phi $ CurrentDesktopUpdate current
-    sendMessage phi $ DesktopNamesUpdate names
-    sendMessage phi $ ActiveWindowUpdate activeWindow
-    return (windows, states)
-  sendMessage phi Repaint
-  
-  flip evalStateT (windows, states) $ forever $ do
-    m <- receiveMessage phi
-    case (fromMessage m) of
-      Just (XEvent event) ->
-        handleEvent phi dispvar event
-      _ ->
-        return ()
-
-
-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 $ 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 conn atoms
-        sendMessage phi $ ActiveWindowUpdate activeWindow
-        sendMessage phi Repaint
-      when (atom == atom_NET_NUMBER_OF_DESKTOPS atoms) $ do
-        desktopCount <- liftIO $ getDesktopCount conn atoms
-        sendMessage phi $ DesktopCountUpdate desktopCount
-        sendMessage phi Repaint
-      when (atom == atom_NET_CURRENT_DESKTOP atoms) $ do
-        current <- liftIO $ getCurrentDesktop conn atoms
-        sendMessage phi $ CurrentDesktopUpdate current
-        sendMessage phi Repaint
-      when (atom == atom_NET_DESKTOP_NAMES atoms) $ do
-        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 conn atoms windowStates
-        
-        when (windows /= windows') $ do
-          sendMessage phi $ WindowListUpdate windows' windowStates'
-          sendMessage phi Repaint
-          put (windows', windowStates')
-    
-      else do
-      (windows, windowStates) <- get
-      when (elem window windows) $ do
-        case () of
-          _ | (atom == atom_NET_WM_ICON atoms) -> do
-            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 conn atoms window
-            let mwindowState = M.lookup window windowStates
-            case mwindowState of
-              Just windowState -> do
-                let windowState' = windowState {windowTitle = name, windowDesktop = desktop, windowVisible = visible}
-            
-                when (windowState /= windowState') $ do
-                  let windowStates' = M.insert window windowState' windowStates
-                  sendMessage phi $ WindowListUpdate windows windowStates'
-                  sendMessage phi Repaint
-                  put (windows, windowStates')
-              Nothing ->
-                return ()
-
-
-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 $ \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')
-
-
-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)
-
-getCurrentDesktop :: Connection -> Atoms -> IO Int
-getCurrentDesktop conn atoms =
-  liftM (fromIntegral . fromMaybe (-1) . join . fmap listToMaybe) $ getProperty32 conn (getRoot conn) (atom_NET_CURRENT_DESKTOP atoms)
-
-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 :: 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 :: 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
-  
-  newWindowStates <- mapM getWindowState' windowStates'
-  
-  return (windows, M.fromList newWindowStates)
-    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
-        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
-  
-  return $ WindowState { windowTitle = name 
-                       , windowDesktop = workspace 
-                       , windowVisible = visible 
-                       , windowIcons = icons
-                       , windowGeometry = geom
-                       }
-
-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 []) $ getProperty8 conn window (atom_NET_WM_NAME atoms)
-  
-  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
-
-getWindowIcons :: Connection -> Atoms -> WINDOW -> IO [Icon]
-getWindowIcons conn atoms window = getProperty32 conn window (atom_NET_WM_ICON atoms) >>= readIcons . fromMaybe []
-
-
-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
-    surface <- createImageSurface FormatARGB32 (fromIntegral width) (fromIntegral height)
-    surfaceData <- imageSurfaceGetPixels surface :: IO (SurfaceData Int Word32)
-    forM_ (zip thisIcon [0..]) $ \(e, i) -> writeArray surfaceData i $ premultiply $ fromIntegral e
-    
-    surfaceMarkDirty surface
-    
-    liftM2 (:) (createIcon (fromIntegral $ max width height) surface) (readIcons rest)
-
-readIcons _ = return []
-
-premultiply :: Word32 -> Word32
-premultiply c = a .|. r .|. g .|. b
-  where
-    amask = 0xFF000000
-    rmask = 0x00FF0000
-    gmask = 0x0000FF00
-    bmask = 0x000000FF
-    
-    a = c .&. amask
-    pm mask = (((c .&. mask) * (a `shiftR` 24)) `div` 0xFF) .&. mask
-    
-    r = pm rmask
-    g = pm gmask
-    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))
-
-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 
-                    , 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 
-                                                      , atom_NET_WM_WINDOW_TYPE_MENU 
-                                                      , atom_NET_WM_WINDOW_TYPE_SPLASH
-                                                      ]
-                    ]
-
-
-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