{-# LINE 2 "./Graphics/UI/Gtk/Embedding/Socket.chs" #-}
module Graphics.UI.Gtk.Embedding.Socket (
Socket,
SocketClass,
castToSocket, gTypeSocket,
toSocket,
NativeWindowId,
socketNew,
socketHasPlug,
socketAddId,
socketGetId,
socketGetPlugWindow,
socketPlugAdded,
socketPlugRemoved,
) where
import Control.Monad (liftM)
import Data.Maybe (isJust)
import System.Glib.FFI
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Types
{-# LINE 128 "./Graphics/UI/Gtk/Embedding/Socket.chs" #-}
import Graphics.UI.Gtk.Embedding.Types
{-# LINE 129 "./Graphics/UI/Gtk/Embedding/Socket.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 130 "./Graphics/UI/Gtk/Embedding/Socket.chs" #-}
import Graphics.UI.Gtk.General.Structs
{-# LINE 136 "./Graphics/UI/Gtk/Embedding/Socket.chs" #-}
socketNew :: IO Socket
socketNew :: IO Socket
socketNew =
(ForeignPtr Socket -> Socket, FinalizerPtr Socket)
-> IO (Ptr Socket) -> IO Socket
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Socket -> Socket, FinalizerPtr Socket)
forall {a}. (ForeignPtr Socket -> Socket, FinalizerPtr a)
mkSocket (IO (Ptr Socket) -> IO Socket) -> IO (Ptr Socket) -> IO Socket
forall a b. (a -> b) -> a -> b
$
(Ptr Widget -> Ptr Socket) -> IO (Ptr Widget) -> IO (Ptr Socket)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Socket
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Socket) (IO (Ptr Widget) -> IO (Ptr Socket))
-> IO (Ptr Widget) -> IO (Ptr Socket)
forall a b. (a -> b) -> a -> b
$
IO (Ptr Widget)
gtk_socket_new
{-# LINE 151 "./Graphics/UI/Gtk/Embedding/Socket.chs" #-}
socketAddId :: SocketClass self => self
-> NativeWindowId
-> IO ()
socketAddId :: forall self. SocketClass self => self -> NativeWindowId -> IO ()
socketAddId self
self NativeWindowId
windowId =
(\(Socket ForeignPtr Socket
arg1) CULong
arg2 -> ForeignPtr Socket -> (Ptr Socket -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Socket
arg1 ((Ptr Socket -> IO ()) -> IO ()) -> (Ptr Socket -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Socket
argPtr1 ->Ptr Socket -> CULong -> IO ()
gtk_socket_add_id Ptr Socket
argPtr1 CULong
arg2)
{-# LINE 174 "./Graphics/UI/Gtk/Embedding/Socket.chs" #-}
(toSocket self)
(NativeWindowId -> CULong
forall a. Integral a => NativeWindowId -> a
fromNativeWindowId NativeWindowId
windowId)
socketGetId :: SocketClass self => self -> IO NativeWindowId
socketGetId :: forall self. SocketClass self => self -> IO NativeWindowId
socketGetId self
self =
(CULong -> NativeWindowId) -> IO CULong -> IO NativeWindowId
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CULong -> NativeWindowId
forall a. Integral a => a -> NativeWindowId
toNativeWindowId (IO CULong -> IO NativeWindowId) -> IO CULong -> IO NativeWindowId
forall a b. (a -> b) -> a -> b
$
(\(Socket ForeignPtr Socket
arg1) -> ForeignPtr Socket -> (Ptr Socket -> IO CULong) -> IO CULong
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Socket
arg1 ((Ptr Socket -> IO CULong) -> IO CULong)
-> (Ptr Socket -> IO CULong) -> IO CULong
forall a b. (a -> b) -> a -> b
$ \Ptr Socket
argPtr1 ->Ptr Socket -> IO CULong
gtk_socket_get_id Ptr Socket
argPtr1)
{-# LINE 188 "./Graphics/UI/Gtk/Embedding/Socket.chs" #-}
(toSocket self)
socketGetPlugWindow :: SocketClass self => self
-> IO (Maybe DrawWindow)
socketGetPlugWindow :: forall self. SocketClass self => self -> IO (Maybe DrawWindow)
socketGetPlugWindow self
self =
(IO (Ptr DrawWindow) -> IO DrawWindow)
-> IO (Ptr DrawWindow) -> IO (Maybe DrawWindow)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr DrawWindow)
-> IO (Ptr DrawWindow) -> IO DrawWindow
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr DrawWindow)
forall {a}. (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr a)
mkDrawWindow) (IO (Ptr DrawWindow) -> IO (Maybe DrawWindow))
-> IO (Ptr DrawWindow) -> IO (Maybe DrawWindow)
forall a b. (a -> b) -> a -> b
$
(\(Socket ForeignPtr Socket
arg1) -> ForeignPtr Socket
-> (Ptr Socket -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Socket
arg1 ((Ptr Socket -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow))
-> (Ptr Socket -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow)
forall a b. (a -> b) -> a -> b
$ \Ptr Socket
argPtr1 ->Ptr Socket -> IO (Ptr DrawWindow)
gtk_socket_get_plug_window Ptr Socket
argPtr1)
{-# LINE 202 "./Graphics/UI/Gtk/Embedding/Socket.chs" #-}
(toSocket self)
socketHasPlug :: SocketClass s => s -> IO Bool
socketHasPlug :: forall s. SocketClass s => s -> IO Bool
socketHasPlug = (Maybe DrawWindow -> Bool) -> IO (Maybe DrawWindow) -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Maybe DrawWindow -> Bool
forall a. Maybe a -> Bool
isJust (IO (Maybe DrawWindow) -> IO Bool)
-> (s -> IO (Maybe DrawWindow)) -> s -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> IO (Maybe DrawWindow)
forall self. SocketClass self => self -> IO (Maybe DrawWindow)
socketGetPlugWindow
socketPlugAdded :: SocketClass self => Signal self (IO ())
socketPlugAdded :: forall self. SocketClass self => Signal self (IO ())
socketPlugAdded = (Bool -> self -> IO () -> IO (ConnectId self))
-> Signal self (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (SignalName -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
SignalName -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE SignalName
"plug-added")
socketPlugRemoved :: SocketClass self => Signal self (IO Bool)
socketPlugRemoved :: forall self. SocketClass self => Signal self (IO Bool)
socketPlugRemoved = (Bool -> self -> IO Bool -> IO (ConnectId self))
-> Signal self (IO Bool)
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (SignalName -> Bool -> self -> IO Bool -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
SignalName -> Bool -> obj -> IO Bool -> IO (ConnectId obj)
connect_NONE__BOOL SignalName
"plug-removed")
foreign import ccall unsafe "gtk_socket_new"
gtk_socket_new :: (IO (Ptr Widget))
foreign import ccall unsafe "gtk_socket_add_id"
gtk_socket_add_id :: ((Ptr Socket) -> (CULong -> (IO ())))
foreign import ccall unsafe "gtk_socket_get_id"
gtk_socket_get_id :: ((Ptr Socket) -> (IO CULong))
foreign import ccall safe "gtk_socket_get_plug_window"
gtk_socket_get_plug_window :: ((Ptr Socket) -> (IO (Ptr DrawWindow)))