Core is independent of X11 now

1 files changed, 0 insertions, 294 deletions

diff --git a/lib/Phi/Widgets/Systray.hs b/lib/Phi/Widgets/Systray.hs
deleted file mode 100644
index 27a5e34..0000000
--- a/lib/Phi/Widgets/Systray.hs
+++ /dev/null
@@ -1,294 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances #-}
-
-module Phi.Widgets.Systray ( systray
-                           ) where
-
-import Control.Concurrent
-import Control.Monad
-import Control.Monad.State
-import Control.Monad.Trans
-
-import Data.Bits
-import Data.IORef
-import Data.Maybe
-import Data.Typeable
-import qualified Data.Map as M
-
-import Foreign.C.Types
-import Foreign.Marshal
-import Foreign.Ptr
-import Foreign.Storable
-
-import Graphics.Rendering.Cairo
-import Graphics.Rendering.Cairo.Types
-
-import Graphics.X11.Xlib hiding (Display)
-import qualified Graphics.X11.Xlib as Xlib
-import Graphics.X11.Xlib.Extras
-
-import Phi.Bindings.Util
-import Phi.Bindings.SystrayErrorHandler
-
-import Phi.Phi
-import Phi.Types
-import Phi.Widget
-import Phi.X11.Atoms
-
-
-data SystrayIconState = SystrayIconState !Window !Window deriving (Show, Eq)
-
-instance Eq Phi where
-  _ == _ = True
-
-data SystrayState = SystrayState !Phi !Rectangle !Int ![SystrayIconState] deriving Eq
-
-data Systray = Systray deriving (Show, Eq)
-
-data SystrayMessage = AddIcon !Window !Window | RemoveIcon !Window | RenderIcon !Window !Window !Int !Int !Int !Int
-                      deriving (Show, Typeable)
-
-
-instance Widget Systray SystrayState (RenderCache SystrayState) where
-  initWidget (Systray) phi dispvar screens = do
-    phi' <- dupPhi phi
-    forkIO $ systrayRunner phi' dispvar $ snd . head $ screens
-    
-    return $ SystrayState phi (fst . head $ screens) 0 []
-  
-  initCache _ = createRenderCache $ \(SystrayState phi systrayScreen reset icons) x y w h screen -> do
-    when (screen == systrayScreen) $ do
-      forM_ (zip [0..] icons) $ \(i, SystrayIconState midParent window) -> do
-        let x' = x + i*(h+2)
-        sendMessage phi $ RenderIcon midParent window x' y h h
-    
-    setOperator OperatorClear
-    paint
-  
-  minSize _ (SystrayState _ systrayScreen _ icons) height screen = case True of 
-    _ | screen == systrayScreen -> max 0 $ (length icons)*(height+2)-1
-      | otherwise -> 0
-
-  weight _ = 0
-  
-  render _ = renderCached
-
-  
-  handleMessage _ priv@(SystrayState phi screen reset icons) m = case (fromMessage m) of
-    Just (AddIcon midParent window) -> SystrayState phi screen reset ((SystrayIconState midParent window):icons)
-    Just (RemoveIcon window) -> SystrayState phi screen reset $ filter (\(SystrayIconState _ stateWindow) -> stateWindow /= window) icons
-    _ -> case (fromMessage m) of
-      Just (UpdateScreens screens) -> SystrayState phi (fst . head $ screens) reset icons
-      _ -> case (fromMessage m) of
-        Just ResetBackground -> SystrayState phi screen (reset+1) icons
-        _ ->  priv
-
-
-systrayRunner :: Phi -> Display -> Window -> IO ()
-systrayRunner phi dispvar panelWindow = do
-  let atoms = getAtoms dispvar
-  initSuccess <- withDisplay dispvar $ flip initSystray atoms
-  
-  case initSuccess of
-    Just xembedWindow -> flip evalStateT M.empty $ do
-      sendMessage phi HoldShutdown
-      
-      forever $ do
-        m <- receiveMessage phi
-        case (fromMessage m) of
-          Just event ->
-            handleEvent event phi dispvar panelWindow xembedWindow
-          _ ->
-            case (fromMessage m) of
-              Just (RenderIcon midParent window x y w h) -> do
-                withDisplay dispvar $ \disp -> do
-                  liftIO $ flip catch (\_ -> return ()) $ do
-                    sync disp False
-                    setSystrayErrorHandler
-                    
-                    (_, x', y', w', h', _, _) <- getGeometry disp midParent
-                    (_, x'', y'', w'', h'', _, _) <- getGeometry disp window
-                    let resize = (fromIntegral x) /= x' || (fromIntegral y) /= y' || (fromIntegral w) /= w' || (fromIntegral h) /= h'
-                                 || 0 /= x'' || 0 /= y'' || (fromIntegral w) /= w'' || (fromIntegral h) /= h''
-                    
-                    when resize $ do
-                      moveResizeWindow disp midParent (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h)
-                      moveResizeWindow disp window 0 0 (fromIntegral w) (fromIntegral h)
-                      sync disp False
-                    
-                    clearArea disp window 0 0 (fromIntegral w) (fromIntegral h) True
-                      
-                    sync disp False
-                    xSetErrorHandler
-                  
-                  lastErrorWindow <- liftIO $ getLastErrorWindow
-                  when (lastErrorWindow == window) $ do
-                    removeIcon phi disp True window
-              _ ->
-                case (fromMessage m) of
-                  Just Shutdown -> do
-                    windows <- gets M.keys
-                    withDisplay dispvar $ \disp -> do
-                      mapM_ (removeIcon phi disp True) windows
-                      liftIO $ do
-                        destroyWindow disp xembedWindow
-                        sync disp False
-                      sendMessage phi ReleaseShutdown
-                  _ ->
-                    return ()
-    Nothing ->
-      return ()
-
-
-initSystray :: Xlib.Display -> Atoms -> IO (Maybe Window)
-initSystray disp atoms = do
-  currentSystrayWin <- xGetSelectionOwner disp $ atom_NET_SYSTEM_TRAY_SCREEN atoms
-  
-  if currentSystrayWin /= 0 then do
-    pid <- liftM (fromMaybe "" . fmap (\pid -> " (pid" ++ show (fromIntegral pid :: CUShort) ++ ")") . join . fmap listToMaybe) $
-           getWindowProperty16 disp (atom_NET_WM_PID atoms) currentSystrayWin
-    
-    putStrLn $ "Phi: another systray is running." ++ pid
-    
-    return Nothing
-    else do
-    xembedWin <- createSimpleWindow disp (defaultRootWindow disp) (-1) (-1) 1 1 0 0 0
-    
-    -- orient horizontally
-    changeProperty32 disp xembedWin (atom_NET_SYSTEM_TRAY_ORIENTATION atoms) cARDINAL propModeReplace [0]
-    
-    -- set visual
-    let rootwin = defaultRootWindow disp
-        screen = defaultScreen disp
-        visual = defaultVisual disp screen
-        visualID = visualIDFromVisual visual
-    changeProperty32 disp xembedWin (atom_NET_SYSTEM_TRAY_VISUAL atoms) vISUALID propModeReplace [fromIntegral visualID]
-    
-    xSetSelectionOwner disp (atom_NET_SYSTEM_TRAY_SCREEN atoms) xembedWin currentTime
-    systrayWin <- xGetSelectionOwner disp $ atom_NET_SYSTEM_TRAY_SCREEN atoms
-    if systrayWin /= xembedWin then do
-      destroyWindow disp xembedWin
-      putStrLn $ "Phi: can't initialize systray."
-      return Nothing
-      
-      else do
-      allocaXEvent $ \event -> do
-        putClientMessage event rootwin (atomMANAGER atoms) [fromIntegral currentTime, fromIntegral (atom_NET_SYSTEM_TRAY_SCREEN atoms), fromIntegral xembedWin, 0, 0]
-        sendEvent disp rootwin False structureNotifyMask event
-      
-      return $ Just xembedWin
-
-
-sYSTEM_TRAY_REQUEST_DOCK :: CInt
-sYSTEM_TRAY_REQUEST_DOCK = 0
-
-sYSTEM_TRAY_BEGIN_MESSAGE :: CInt
-sYSTEM_TRAY_BEGIN_MESSAGE = 1
-
-sYSTEM_TRAY_CANCEL_MESSAGE :: CInt
-sYSTEM_TRAY_CANCEL_MESSAGE = 2
-
-xEMBED_EMBEDDED_NOTIFY :: CInt
-xEMBED_EMBEDDED_NOTIFY = 0
-
-handleEvent :: Event -> Phi -> Display -> Window -> Window -> StateT (M.Map Window Window) IO ()
-handleEvent message@ClientMessageEvent { ev_message_type = message_type, ev_data = messageData, ev_window = window } phi dispvar panelWindow xembedWindow = do
-  let atoms = getAtoms dispvar
-  when (window == xembedWindow && message_type == atom_NET_SYSTEM_TRAY_OPCODE atoms) $ do
-    case messageData of
-      _:opcode:iconID:_ -> do
-        case True of
-          _ | opcode == sYSTEM_TRAY_REQUEST_DOCK -> do
-            when (iconID /= 0) $ withDisplay dispvar $ \disp -> addIcon phi disp (getAtoms dispvar) panelWindow $ fromIntegral iconID
-          
-            | opcode == sYSTEM_TRAY_BEGIN_MESSAGE || opcode == sYSTEM_TRAY_CANCEL_MESSAGE ->
-            return ()
-            
-            | otherwise -> do
-            liftIO $ putStrLn "Phi: unknown tray message"
-            return ()
-        
-          
-      _ ->
-        return ()
-
-handleEvent message@UnmapEvent { ev_window = window } phi dispvar panelWindow xembedWindow =
-  withDisplay dispvar $ \disp -> removeIcon phi disp True window
-
-handleEvent message@DestroyWindowEvent { ev_window = window } phi dispvar panelWindow xembedWindow =
-  withDisplay dispvar $ \disp -> removeIcon phi disp False window
-
-handleEvent message@AnyEvent { ev_window = window } phi dispvar panelWindow xembedWindow | ev_event_type message == reparentNotify = do
-  parent <- liftIO $ alloca $ \rootPtr -> alloca $ \parentPtr -> alloca $ \childrenPtrPtr -> alloca $ \nChildrenPtr -> do
-    status <- withDisplay dispvar $ \disp -> xQueryTree disp window rootPtr parentPtr childrenPtrPtr nChildrenPtr
-    case status of
-      0 ->
-        return 0
-      _ -> do
-        childrenPtr <- peek childrenPtrPtr
-        when (childrenPtr /= nullPtr) $
-          xFree childrenPtr >> return ()
-        peek parentPtr
-  midParent <- gets $ M.lookup window
-  when (midParent /= Just parent) $
-    withDisplay dispvar $ \disp -> removeIcon phi disp False window
-  return ()
-
-handleEvent _ _ _ _ _ = return ()
-
-
-addIcon :: Phi -> Xlib.Display -> Atoms -> Window -> Window -> StateT (M.Map Window Window) IO ()
-addIcon phi disp atoms panelWindow window = do
-  removeIcon phi disp False window
-  
-  liftIO $ selectInput disp window $ structureNotifyMask .|. propertyChangeMask
-  
-  midParent <- liftIO $ createSimpleWindow disp panelWindow (-16) (-16) 16 16 0 0 0
-  
-  liftIO $ do
-    setWindowBackgroundPixmap disp midParent 1 -- ParentRelative
-    
-    sync disp False
-    setSystrayErrorHandler
-    
-    reparentWindow disp window midParent 0 0
-    
-    mapRaised disp midParent
-    mapWindow disp window
-    
-    allocaXEvent $ \event -> do
-      putClientMessage event window (atom_XEMBED atoms) [fromIntegral currentTime, fromIntegral xEMBED_EMBEDDED_NOTIFY, 0, fromIntegral midParent, 0]
-      sendEvent disp window False 0xFFFFFF event
-    
-    sync disp False
-    xSetErrorHandler
-  
-  errorWindow <- liftIO $ getLastErrorWindow
-  case True of
-    _ | errorWindow /= window -> do
-      sendMessage phi $ AddIcon midParent window
-      sendMessage phi Repaint
-      modify $ M.insert window midParent
-      | otherwise ->
-      liftIO $ destroyWindow disp midParent
-
-
-removeIcon :: Phi -> Xlib.Display -> Bool -> Window -> StateT (M.Map Window Window) IO ()
-removeIcon phi disp reparent window = do
-  mmidParent <- gets $ M.lookup window
-  case mmidParent of
-    Just midParent -> do
-      sendMessage phi $ RemoveIcon window
-      sendMessage phi Repaint
-      liftIO $ do
-        selectInput disp window $ noEventMask
-        when reparent $
-          reparentWindow disp window (defaultRootWindow disp) 0 0
-        destroyWindow disp midParent
-        sync disp False
-      modify $ M.delete window
-    _ ->
-      return ()
-
-
-systray :: Systray
-systray = Systray