{-# LINE 2 "./Graphics/UI/Gtk/Misc/HandleBox.chs" #-}
module Graphics.UI.Gtk.Misc.HandleBox (
HandleBox,
HandleBoxClass,
castToHandleBox, gTypeHandleBox,
toHandleBox,
handleBoxNew,
ShadowType(..),
handleBoxSetShadowType,
handleBoxGetShadowType,
PositionType(..),
handleBoxSetHandlePosition,
handleBoxGetHandlePosition,
handleBoxSetSnapEdge,
handleBoxGetSnapEdge,
handleBoxShadowType,
handleBoxHandlePosition,
handleBoxSnapEdge,
handleBoxSnapEdgeSet,
onChildAttached,
afterChildAttached,
onChildDetached,
afterChildDetached,
) where
import Control.Monad (liftM)
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 101 "./Graphics/UI/Gtk/Misc/HandleBox.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 102 "./Graphics/UI/Gtk/Misc/HandleBox.chs" #-}
import Graphics.UI.Gtk.General.Enums (ShadowType(..), PositionType(..))
{-# LINE 105 "./Graphics/UI/Gtk/Misc/HandleBox.chs" #-}
handleBoxNew :: IO HandleBox
handleBoxNew :: IO HandleBox
handleBoxNew =
(ForeignPtr HandleBox -> HandleBox, FinalizerPtr HandleBox)
-> IO (Ptr HandleBox) -> IO HandleBox
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr HandleBox -> HandleBox, FinalizerPtr HandleBox)
forall {a}. (ForeignPtr HandleBox -> HandleBox, FinalizerPtr a)
mkHandleBox (IO (Ptr HandleBox) -> IO HandleBox)
-> IO (Ptr HandleBox) -> IO HandleBox
forall a b. (a -> b) -> a -> b
$
(Ptr Widget -> Ptr HandleBox)
-> IO (Ptr Widget) -> IO (Ptr HandleBox)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr HandleBox
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr HandleBox) (IO (Ptr Widget) -> IO (Ptr HandleBox))
-> IO (Ptr Widget) -> IO (Ptr HandleBox)
forall a b. (a -> b) -> a -> b
$
IO (Ptr Widget)
gtk_handle_box_new
{-# LINE 116 "./Graphics/UI/Gtk/Misc/HandleBox.chs" #-}
handleBoxSetShadowType :: HandleBoxClass self => self -> ShadowType -> IO ()
handleBoxSetShadowType :: forall self. HandleBoxClass self => self -> ShadowType -> IO ()
handleBoxSetShadowType self
self ShadowType
type_ =
(\(HandleBox ForeignPtr HandleBox
arg1) CInt
arg2 -> ForeignPtr HandleBox -> (Ptr HandleBox -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr HandleBox
arg1 ((Ptr HandleBox -> IO ()) -> IO ())
-> (Ptr HandleBox -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr HandleBox
argPtr1 ->Ptr HandleBox -> CInt -> IO ()
gtk_handle_box_set_shadow_type Ptr HandleBox
argPtr1 CInt
arg2)
{-# LINE 125 "./Graphics/UI/Gtk/Misc/HandleBox.chs" #-}
(toHandleBox self)
((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (ShadowType -> Int) -> ShadowType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShadowType -> Int
forall a. Enum a => a -> Int
fromEnum) ShadowType
type_)
handleBoxGetShadowType :: HandleBoxClass self => self
-> IO ShadowType
handleBoxGetShadowType :: forall self. HandleBoxClass self => self -> IO ShadowType
handleBoxGetShadowType self
self =
(CInt -> ShadowType) -> IO CInt -> IO ShadowType
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> ShadowType
forall a. Enum a => Int -> a
toEnum (Int -> ShadowType) -> (CInt -> Int) -> CInt -> ShadowType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO ShadowType) -> IO CInt -> IO ShadowType
forall a b. (a -> b) -> a -> b
$
(\(HandleBox ForeignPtr HandleBox
arg1) -> ForeignPtr HandleBox -> (Ptr HandleBox -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr HandleBox
arg1 ((Ptr HandleBox -> IO CInt) -> IO CInt)
-> (Ptr HandleBox -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr HandleBox
argPtr1 ->Ptr HandleBox -> IO CInt
gtk_handle_box_get_shadow_type Ptr HandleBox
argPtr1)
{-# LINE 137 "./Graphics/UI/Gtk/Misc/HandleBox.chs" #-}
(toHandleBox self)
handleBoxSetHandlePosition :: HandleBoxClass self => self
-> PositionType
-> IO ()
handleBoxSetHandlePosition :: forall self. HandleBoxClass self => self -> PositionType -> IO ()
handleBoxSetHandlePosition self
self PositionType
position =
(\(HandleBox ForeignPtr HandleBox
arg1) CInt
arg2 -> ForeignPtr HandleBox -> (Ptr HandleBox -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr HandleBox
arg1 ((Ptr HandleBox -> IO ()) -> IO ())
-> (Ptr HandleBox -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr HandleBox
argPtr1 ->Ptr HandleBox -> CInt -> IO ()
gtk_handle_box_set_handle_position Ptr HandleBox
argPtr1 CInt
arg2)
{-# LINE 147 "./Graphics/UI/Gtk/Misc/HandleBox.chs" #-}
(toHandleBox self)
((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (PositionType -> Int) -> PositionType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionType -> Int
forall a. Enum a => a -> Int
fromEnum) PositionType
position)
handleBoxGetHandlePosition :: HandleBoxClass self => self
-> IO PositionType
handleBoxGetHandlePosition :: forall self. HandleBoxClass self => self -> IO PositionType
handleBoxGetHandlePosition self
self =
(CInt -> PositionType) -> IO CInt -> IO PositionType
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> PositionType
forall a. Enum a => Int -> a
toEnum (Int -> PositionType) -> (CInt -> Int) -> CInt -> PositionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO PositionType) -> IO CInt -> IO PositionType
forall a b. (a -> b) -> a -> b
$
(\(HandleBox ForeignPtr HandleBox
arg1) -> ForeignPtr HandleBox -> (Ptr HandleBox -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr HandleBox
arg1 ((Ptr HandleBox -> IO CInt) -> IO CInt)
-> (Ptr HandleBox -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr HandleBox
argPtr1 ->Ptr HandleBox -> IO CInt
gtk_handle_box_get_handle_position Ptr HandleBox
argPtr1)
{-# LINE 158 "./Graphics/UI/Gtk/Misc/HandleBox.chs" #-}
(toHandleBox self)
handleBoxSetSnapEdge :: HandleBoxClass self => self
-> PositionType
-> IO ()
handleBoxSetSnapEdge :: forall self. HandleBoxClass self => self -> PositionType -> IO ()
handleBoxSetSnapEdge self
self PositionType
edge =
(\(HandleBox ForeignPtr HandleBox
arg1) CInt
arg2 -> ForeignPtr HandleBox -> (Ptr HandleBox -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr HandleBox
arg1 ((Ptr HandleBox -> IO ()) -> IO ())
-> (Ptr HandleBox -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr HandleBox
argPtr1 ->Ptr HandleBox -> CInt -> IO ()
gtk_handle_box_set_snap_edge Ptr HandleBox
argPtr1 CInt
arg2)
{-# LINE 175 "./Graphics/UI/Gtk/Misc/HandleBox.chs" #-}
(toHandleBox self)
((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (PositionType -> Int) -> PositionType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionType -> Int
forall a. Enum a => a -> Int
fromEnum) PositionType
edge)
handleBoxGetSnapEdge :: HandleBoxClass self => self
-> IO PositionType
handleBoxGetSnapEdge :: forall self. HandleBoxClass self => self -> IO PositionType
handleBoxGetSnapEdge self
self =
(CInt -> PositionType) -> IO CInt -> IO PositionType
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> PositionType
forall a. Enum a => Int -> a
toEnum (Int -> PositionType) -> (CInt -> Int) -> CInt -> PositionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO PositionType) -> IO CInt -> IO PositionType
forall a b. (a -> b) -> a -> b
$
(\(HandleBox ForeignPtr HandleBox
arg1) -> ForeignPtr HandleBox -> (Ptr HandleBox -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr HandleBox
arg1 ((Ptr HandleBox -> IO CInt) -> IO CInt)
-> (Ptr HandleBox -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr HandleBox
argPtr1 ->Ptr HandleBox -> IO CInt
gtk_handle_box_get_snap_edge Ptr HandleBox
argPtr1)
{-# LINE 186 "./Graphics/UI/Gtk/Misc/HandleBox.chs" #-}
(toHandleBox self)
handleBoxShadowType :: HandleBoxClass self => Attr self ShadowType
handleBoxShadowType :: forall self. HandleBoxClass self => Attr self ShadowType
handleBoxShadowType = (self -> IO ShadowType)
-> (self -> ShadowType -> IO ())
-> ReadWriteAttr self ShadowType ShadowType
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO ShadowType
forall self. HandleBoxClass self => self -> IO ShadowType
handleBoxGetShadowType
self -> ShadowType -> IO ()
forall self. HandleBoxClass self => self -> ShadowType -> IO ()
handleBoxSetShadowType
handleBoxHandlePosition :: HandleBoxClass self => Attr self PositionType
handleBoxHandlePosition :: forall self. HandleBoxClass self => Attr self PositionType
handleBoxHandlePosition = (self -> IO PositionType)
-> (self -> PositionType -> IO ())
-> ReadWriteAttr self PositionType PositionType
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO PositionType
forall self. HandleBoxClass self => self -> IO PositionType
handleBoxGetHandlePosition
self -> PositionType -> IO ()
forall self. HandleBoxClass self => self -> PositionType -> IO ()
handleBoxSetHandlePosition
handleBoxSnapEdge :: HandleBoxClass self => Attr self PositionType
handleBoxSnapEdge :: forall self. HandleBoxClass self => Attr self PositionType
handleBoxSnapEdge = (self -> IO PositionType)
-> (self -> PositionType -> IO ())
-> ReadWriteAttr self PositionType PositionType
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO PositionType
forall self. HandleBoxClass self => self -> IO PositionType
handleBoxGetSnapEdge
self -> PositionType -> IO ()
forall self. HandleBoxClass self => self -> PositionType -> IO ()
handleBoxSetSnapEdge
handleBoxSnapEdgeSet :: HandleBoxClass self => Attr self Bool
handleBoxSnapEdgeSet :: forall self. HandleBoxClass self => Attr self Bool
handleBoxSnapEdgeSet = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"snap-edge-set"
onChildAttached, afterChildAttached :: HandleBoxClass self => self
-> IO ()
-> IO (ConnectId self)
onChildAttached :: forall self.
HandleBoxClass self =>
self -> IO () -> IO (ConnectId self)
onChildAttached = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"child-attached" Bool
False
afterChildAttached :: forall self.
HandleBoxClass self =>
self -> IO () -> IO (ConnectId self)
afterChildAttached = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"child-attached" Bool
True
onChildDetached, afterChildDetached :: HandleBoxClass self => self
-> IO ()
-> IO (ConnectId self)
onChildDetached :: forall self.
HandleBoxClass self =>
self -> IO () -> IO (ConnectId self)
onChildDetached = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"child-detached" Bool
False
afterChildDetached :: forall self.
HandleBoxClass self =>
self -> IO () -> IO (ConnectId self)
afterChildDetached = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"child-detached" Bool
True
foreign import ccall unsafe "gtk_handle_box_new"
gtk_handle_box_new :: (IO (Ptr Widget))
foreign import ccall safe "gtk_handle_box_set_shadow_type"
gtk_handle_box_set_shadow_type :: ((Ptr HandleBox) -> (CInt -> (IO ())))
foreign import ccall unsafe "gtk_handle_box_get_shadow_type"
gtk_handle_box_get_shadow_type :: ((Ptr HandleBox) -> (IO CInt))
foreign import ccall safe "gtk_handle_box_set_handle_position"
gtk_handle_box_set_handle_position :: ((Ptr HandleBox) -> (CInt -> (IO ())))
foreign import ccall unsafe "gtk_handle_box_get_handle_position"
gtk_handle_box_get_handle_position :: ((Ptr HandleBox) -> (IO CInt))
foreign import ccall safe "gtk_handle_box_set_snap_edge"
gtk_handle_box_set_snap_edge :: ((Ptr HandleBox) -> (CInt -> (IO ())))
foreign import ccall unsafe "gtk_handle_box_get_snap_edge"
gtk_handle_box_get_snap_edge :: ((Ptr HandleBox) -> (IO CInt))