{-# LANGUAGE OverloadedStrings #-}
{-# LINE 2 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}
module Graphics.UI.Gtk.Windows.MessageDialog (
MessageDialog,
MessageDialogClass,
castToMessageDialog, gTypeMessageDialog,
toMessageDialog,
MessageType(..),
ButtonsType(..),
DialogFlags(..),
messageDialogNew,
messageDialogNewWithMarkup,
messageDialogSetMarkup,
messageDialogSetImage,
messageDialogSetSecondaryMarkup,
messageDialogSetSecondaryText,
messageDialogMessageType,
messageDialogText,
messageDialogUseMarkup,
messageDialogSecondaryText,
messageDialogSecondaryUseMarkup,
messageDialogImage,
messageDialogButtons,
messageDialogMessageArea,
) where
import Control.Monad (liftM)
import System.Glib.FFI
import Graphics.UI.Gtk.Types
{-# LINE 101 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}
import System.Glib.UTFString
import System.Glib.Attributes
import System.Glib.Properties
import System.Glib.Flags (Flags, fromFlags)
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
{-# LINE 108 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}
data MessageType = MessageInfo
| MessageWarning
| MessageQuestion
| MessageError
| MessageOther
deriving (Int -> MessageType
MessageType -> Int
MessageType -> [MessageType]
MessageType -> MessageType
MessageType -> MessageType -> [MessageType]
MessageType -> MessageType -> MessageType -> [MessageType]
(MessageType -> MessageType)
-> (MessageType -> MessageType)
-> (Int -> MessageType)
-> (MessageType -> Int)
-> (MessageType -> [MessageType])
-> (MessageType -> MessageType -> [MessageType])
-> (MessageType -> MessageType -> [MessageType])
-> (MessageType -> MessageType -> MessageType -> [MessageType])
-> Enum MessageType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MessageType -> MessageType
succ :: MessageType -> MessageType
$cpred :: MessageType -> MessageType
pred :: MessageType -> MessageType
$ctoEnum :: Int -> MessageType
toEnum :: Int -> MessageType
$cfromEnum :: MessageType -> Int
fromEnum :: MessageType -> Int
$cenumFrom :: MessageType -> [MessageType]
enumFrom :: MessageType -> [MessageType]
$cenumFromThen :: MessageType -> MessageType -> [MessageType]
enumFromThen :: MessageType -> MessageType -> [MessageType]
$cenumFromTo :: MessageType -> MessageType -> [MessageType]
enumFromTo :: MessageType -> MessageType -> [MessageType]
$cenumFromThenTo :: MessageType -> MessageType -> MessageType -> [MessageType]
enumFromThenTo :: MessageType -> MessageType -> MessageType -> [MessageType]
Enum,Int -> MessageType -> ShowS
[MessageType] -> ShowS
MessageType -> [Char]
(Int -> MessageType -> ShowS)
-> (MessageType -> [Char])
-> ([MessageType] -> ShowS)
-> Show MessageType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageType -> ShowS
showsPrec :: Int -> MessageType -> ShowS
$cshow :: MessageType -> [Char]
show :: MessageType -> [Char]
$cshowList :: [MessageType] -> ShowS
showList :: [MessageType] -> ShowS
Show,MessageType -> MessageType -> Bool
(MessageType -> MessageType -> Bool)
-> (MessageType -> MessageType -> Bool) -> Eq MessageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageType -> MessageType -> Bool
== :: MessageType -> MessageType -> Bool
$c/= :: MessageType -> MessageType -> Bool
/= :: MessageType -> MessageType -> Bool
Eq)
{-# LINE 121 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}
data ButtonsType = ButtonsNone
| ButtonsOk
| ButtonsClose
| ButtonsCancel
| ButtonsYesNo
| ButtonsOkCancel
deriving (Enum,Show,Eq)
{-# LINE 128 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}
data DialogFlags = DialogModal
| DialogDestroyWithParent
|
deriving (Int -> DialogFlags -> ShowS
[DialogFlags] -> ShowS
DialogFlags -> [Char]
(Int -> DialogFlags -> ShowS)
-> (DialogFlags -> [Char])
-> ([DialogFlags] -> ShowS)
-> Show DialogFlags
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DialogFlags -> ShowS
showsPrec :: Int -> DialogFlags -> ShowS
$cshow :: DialogFlags -> [Char]
show :: DialogFlags -> [Char]
$cshowList :: [DialogFlags] -> ShowS
showList :: [DialogFlags] -> ShowS
Show,DialogFlags -> DialogFlags -> Bool
(DialogFlags -> DialogFlags -> Bool)
-> (DialogFlags -> DialogFlags -> Bool) -> Eq DialogFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DialogFlags -> DialogFlags -> Bool
== :: DialogFlags -> DialogFlags -> Bool
$c/= :: DialogFlags -> DialogFlags -> Bool
/= :: DialogFlags -> DialogFlags -> Bool
Eq,DialogFlags
DialogFlags -> DialogFlags -> Bounded DialogFlags
forall a. a -> a -> Bounded a
$cminBound :: DialogFlags
minBound :: DialogFlags
$cmaxBound :: DialogFlags
maxBound :: DialogFlags
Bounded)
instance Enum DialogFlags where
fromEnum :: DialogFlags -> Int
fromEnum DialogFlags
DialogModal = Int
1
fromEnum DialogFlags
DialogDestroyWithParent = Int
2
fromEnum DialogFlags
DialogUseHeaderBar = Int
4
toEnum :: Int -> DialogFlags
toEnum Int
1 = DialogFlags
DialogModal
toEnum Int
2 = DialogFlags
DialogDestroyWithParent
toEnum Int
4 = DialogFlags
DialogUseHeaderBar
toEnum Int
unmatched = [Char] -> DialogFlags
forall a. HasCallStack => [Char] -> a
error ([Char]
"DialogFlags.toEnum: Cannot match " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
unmatched)
succ DialogModal = DialogDestroyWithParent
succ DialogDestroyWithParent = DialogUseHeaderBar
succ _ = undefined
pred DialogDestroyWithParent = DialogModal
pred DialogUseHeaderBar = DialogDestroyWithParent
pred _ = undefined
enumFromTo x y | fromEnum x == fromEnum y = [ y ]
| otherwise = x : enumFromTo (succ x) y
enumFrom x = enumFromTo x DialogUseHeaderBar
enumFromThen _ _ = error "Enum DialogFlags: enumFromThen not implemented"
enumFromThenTo :: DialogFlags -> DialogFlags -> DialogFlags -> [DialogFlags]
enumFromThenTo DialogFlags
_ DialogFlags
_ DialogFlags
_ = [Char] -> [DialogFlags]
forall a. HasCallStack => [Char] -> a
error [Char]
"Enum DialogFlags: enumFromThenTo not implemented"
{-# LINE 140 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}
instance Flags DialogFlags
messageDialogNew
:: GlibString string
=> Maybe Window
-> [DialogFlags]
-> MessageType
-> ButtonsType
-> string
-> IO MessageDialog
messageDialogNew mWindow flags mType bType msg =
withUTFString (unPrintf msg) $ \msgPtr ->
makeNewObject mkMessageDialog $
liftM (castPtr :: Ptr Widget -> Ptr MessageDialog) $
call_message_dialog_new mWindow flags mType bType msgPtr
call_message_dialog_new :: Maybe Window -> [DialogFlags] ->
MessageType -> ButtonsType -> Ptr CChar ->
IO (Ptr Widget)
call_message_dialog_new :: Maybe Window
-> [DialogFlags]
-> MessageType
-> ButtonsType
-> CString
-> IO (Ptr Widget)
call_message_dialog_new (Just (Window ForeignPtr Window
fPtr)) [DialogFlags]
flags MessageType
mType ButtonsType
bType CString
msgPtr =
ForeignPtr Window
-> (Ptr Window -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
fPtr ((Ptr Window -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Window -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Window
ptr ->
Ptr Window -> CInt -> CInt -> CInt -> CString -> IO (Ptr Widget)
message_dialog_new Ptr Window
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([DialogFlags] -> Int
forall a. Flags a => [a] -> Int
fromFlags [DialogFlags]
flags))
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (MessageType -> Int
forall a. Enum a => a -> Int
fromEnum MessageType
mType))
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ButtonsType -> Int
forall a. Enum a => a -> Int
fromEnum ButtonsType
bType)) CString
msgPtr
call_message_dialog_new Maybe Window
Nothing [DialogFlags]
flags MessageType
mType ButtonsType
bType CString
msgPtr =
Ptr Window -> CInt -> CInt -> CInt -> CString -> IO (Ptr Widget)
message_dialog_new Ptr Window
forall a. Ptr a
nullPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([DialogFlags] -> Int
forall a. Flags a => [a] -> Int
fromFlags [DialogFlags]
flags))
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (MessageType -> Int
forall a. Enum a => a -> Int
fromEnum MessageType
mType))
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ButtonsType -> Int
forall a. Enum a => a -> Int
fromEnum ButtonsType
bType)) CString
msgPtr
foreign import ccall unsafe "gtk_message_dialog_new"
message_dialog_new :: Ptr Window -> CInt -> CInt -> CInt ->
Ptr CChar -> IO (Ptr Widget)
messageDialogNewWithMarkup
:: GlibString string
=> Maybe Window
-> [DialogFlags]
-> MessageType
-> ButtonsType
-> string
-> IO MessageDialog
messageDialogNewWithMarkup :: forall string.
GlibString string =>
Maybe Window
-> [DialogFlags]
-> MessageType
-> ButtonsType
-> string
-> IO MessageDialog
messageDialogNewWithMarkup Maybe Window
mWindow [DialogFlags]
flags MessageType
mType ButtonsType
bType string
msg = do
MessageDialog
md <- (ForeignPtr MessageDialog -> MessageDialog,
FinalizerPtr MessageDialog)
-> IO (Ptr MessageDialog) -> IO MessageDialog
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr MessageDialog -> MessageDialog,
FinalizerPtr MessageDialog)
forall {a}.
(ForeignPtr MessageDialog -> MessageDialog, FinalizerPtr a)
mkMessageDialog (IO (Ptr MessageDialog) -> IO MessageDialog)
-> IO (Ptr MessageDialog) -> IO MessageDialog
forall a b. (a -> b) -> a -> b
$
(Ptr Widget -> Ptr MessageDialog)
-> IO (Ptr Widget) -> IO (Ptr MessageDialog)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr MessageDialog
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr MessageDialog) (IO (Ptr Widget) -> IO (Ptr MessageDialog))
-> IO (Ptr Widget) -> IO (Ptr MessageDialog)
forall a b. (a -> b) -> a -> b
$
Maybe Window
-> [DialogFlags]
-> MessageType
-> ButtonsType
-> CString
-> IO (Ptr Widget)
call_message_dialog_new Maybe Window
mWindow [DialogFlags]
flags MessageType
mType ButtonsType
bType CString
forall a. Ptr a
nullPtr
MessageDialog -> string -> IO ()
forall self string.
(MessageDialogClass self, GlibString string) =>
self -> string -> IO ()
messageDialogSetMarkup MessageDialog
md string
msg
MessageDialog -> IO MessageDialog
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MessageDialog
md
messageDialogSetMarkup :: (MessageDialogClass self, GlibString string) => self
-> string
-> IO ()
messageDialogSetMarkup :: forall self string.
(MessageDialogClass self, GlibString string) =>
self -> string -> IO ()
messageDialogSetMarkup self
self string
str =
string -> (CString -> IO ()) -> IO ()
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString (string -> string
forall s. GlibString s => s -> s
unPrintf string
str) ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
strPtr ->
(\(MessageDialog ForeignPtr MessageDialog
arg1) CString
arg2 -> ForeignPtr MessageDialog -> (Ptr MessageDialog -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr MessageDialog
arg1 ((Ptr MessageDialog -> IO ()) -> IO ())
-> (Ptr MessageDialog -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MessageDialog
argPtr1 ->Ptr MessageDialog -> CString -> IO ()
gtk_message_dialog_set_markup Ptr MessageDialog
argPtr1 CString
arg2)
{-# LINE 224 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}
(toMessageDialog self)
CString
strPtr
messageDialogSetSecondaryMarkup :: (MessageDialogClass self, GlibString string) => self
-> string
-> IO ()
messageDialogSetSecondaryMarkup :: forall self string.
(MessageDialogClass self, GlibString string) =>
self -> string -> IO ()
messageDialogSetSecondaryMarkup self
self string
str =
string -> (CString -> IO ()) -> IO ()
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString (string -> string
forall s. GlibString s => s -> s
unPrintf string
str) ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
strPtr ->
let (MessageDialog ForeignPtr MessageDialog
fPtr) = self -> MessageDialog
forall o. MessageDialogClass o => o -> MessageDialog
toMessageDialog self
self in
ForeignPtr MessageDialog -> (Ptr MessageDialog -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr MessageDialog
fPtr ((Ptr MessageDialog -> IO ()) -> IO ())
-> (Ptr MessageDialog -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MessageDialog
ptr ->
Ptr MessageDialog -> CString -> IO ()
message_dialog_format_secondary_markup Ptr MessageDialog
ptr CString
strPtr
foreign import ccall unsafe "gtk_message_dialog_format_secondary_markup"
message_dialog_format_secondary_markup :: Ptr MessageDialog ->
Ptr CChar -> IO ()
messageDialogSetSecondaryText :: (MessageDialogClass self, GlibString string) => self
-> string
-> IO ()
messageDialogSetSecondaryText :: forall self string.
(MessageDialogClass self, GlibString string) =>
self -> string -> IO ()
messageDialogSetSecondaryText self
self string
str =
string -> (CString -> IO ()) -> IO ()
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
str ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
strPtr ->
let (MessageDialog ForeignPtr MessageDialog
fPtr) = self -> MessageDialog
forall o. MessageDialogClass o => o -> MessageDialog
toMessageDialog self
self in
ForeignPtr MessageDialog -> (Ptr MessageDialog -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr MessageDialog
fPtr ((Ptr MessageDialog -> IO ()) -> IO ())
-> (Ptr MessageDialog -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MessageDialog
ptr ->
Ptr MessageDialog -> CString -> IO ()
message_dialog_format_secondary_text Ptr MessageDialog
ptr CString
strPtr
foreign import ccall unsafe "gtk_message_dialog_format_secondary_text"
message_dialog_format_secondary_text :: Ptr MessageDialog ->
Ptr CChar -> IO ()
messageDialogSetImage :: (MessageDialogClass self, WidgetClass image) => self
-> image
-> IO ()
messageDialogSetImage :: forall self image.
(MessageDialogClass self, WidgetClass image) =>
self -> image -> IO ()
messageDialogSetImage self
self image
image =
(\(MessageDialog ForeignPtr MessageDialog
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr MessageDialog -> (Ptr MessageDialog -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr MessageDialog
arg1 ((Ptr MessageDialog -> IO ()) -> IO ())
-> (Ptr MessageDialog -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MessageDialog
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr MessageDialog -> Ptr Widget -> IO ()
gtk_message_dialog_set_image Ptr MessageDialog
argPtr1 Ptr Widget
argPtr2)
{-# LINE 266 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}
(toMessageDialog self)
(image -> Widget
forall o. WidgetClass o => o -> Widget
toWidget image
image)
messageDialogMessageType :: MessageDialogClass self => Attr self MessageType
messageDialogMessageType :: forall self. MessageDialogClass self => Attr self MessageType
messageDialogMessageType = [Char] -> GType -> Attr self MessageType
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
[Char] -> GType -> Attr gobj enum
newAttrFromEnumProperty [Char]
"message-type"
GType
gtk_message_type_get_type
{-# LINE 282 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}
messageDialogText :: (MessageDialogClass self, GlibString string) => Attr self (Maybe string)
messageDialogText :: forall self string.
(MessageDialogClass self, GlibString string) =>
Attr self (Maybe string)
messageDialogText = [Char] -> Attr self (Maybe string)
forall gobj string.
(GObjectClass gobj, GlibString string) =>
[Char] -> Attr gobj (Maybe string)
newAttrFromMaybeStringProperty [Char]
"text"
messageDialogUseMarkup :: MessageDialogClass self => Attr self Bool
messageDialogUseMarkup :: forall self. MessageDialogClass self => Attr self Bool
messageDialogUseMarkup = [Char] -> Attr self Bool
forall gobj. GObjectClass gobj => [Char] -> Attr gobj Bool
newAttrFromBoolProperty [Char]
"use-markup"
messageDialogSecondaryText :: (MessageDialogClass self, GlibString string) => Attr self (Maybe string)
messageDialogSecondaryText :: forall self string.
(MessageDialogClass self, GlibString string) =>
Attr self (Maybe string)
messageDialogSecondaryText = [Char] -> Attr self (Maybe string)
forall gobj string.
(GObjectClass gobj, GlibString string) =>
[Char] -> Attr gobj (Maybe string)
newAttrFromMaybeStringProperty [Char]
"secondary-text"
messageDialogSecondaryUseMarkup :: MessageDialogClass self => Attr self Bool
messageDialogSecondaryUseMarkup :: forall self. MessageDialogClass self => Attr self Bool
messageDialogSecondaryUseMarkup = [Char] -> Attr self Bool
forall gobj. GObjectClass gobj => [Char] -> Attr gobj Bool
newAttrFromBoolProperty [Char]
"secondary-use-markup"
messageDialogImage :: (MessageDialogClass self, WidgetClass widget) => ReadWriteAttr self Widget widget
messageDialogImage :: forall self widget.
(MessageDialogClass self, WidgetClass widget) =>
ReadWriteAttr self Widget widget
messageDialogImage = [Char] -> GType -> ReadWriteAttr self Widget widget
forall gobj gobj' gobj''.
(GObjectClass gobj, GObjectClass gobj', GObjectClass gobj'') =>
[Char] -> GType -> ReadWriteAttr gobj gobj' gobj''
newAttrFromObjectProperty [Char]
"image"
GType
gtk_widget_get_type
{-# LINE 331 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}
messageDialogButtons :: MessageDialogClass self => WriteAttr self ButtonsType
messageDialogButtons :: forall self. MessageDialogClass self => WriteAttr self ButtonsType
messageDialogButtons = [Char] -> GType -> WriteAttr self ButtonsType
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
[Char] -> GType -> WriteAttr gobj enum
writeAttrFromEnumProperty [Char]
"buttons"
GType
gtk_buttons_type_get_type
{-# LINE 340 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}
messageDialogMessageArea :: MessageDialogClass self => ReadAttr self VBox
messageDialogMessageArea :: forall self. MessageDialogClass self => ReadAttr self VBox
messageDialogMessageArea = [Char] -> GType -> ReadAttr self VBox
forall gobj gobj'.
(GObjectClass gobj, GObjectClass gobj') =>
[Char] -> GType -> ReadAttr gobj gobj'
readAttrFromObjectProperty [Char]
"message-area"
GType
gtk_vbox_get_type
{-# LINE 349 "./Graphics/UI/Gtk/Windows/MessageDialog.chs" #-}
foreign import ccall safe "gtk_message_dialog_set_markup"
gtk_message_dialog_set_markup :: ((Ptr MessageDialog) -> ((Ptr CChar) -> (IO ())))
foreign import ccall safe "gtk_message_dialog_set_image"
gtk_message_dialog_set_image :: ((Ptr MessageDialog) -> ((Ptr Widget) -> (IO ())))
foreign import ccall unsafe "gtk_message_type_get_type"
gtk_message_type_get_type :: CULong
foreign import ccall unsafe "gtk_widget_get_type"
gtk_widget_get_type :: CULong
foreign import ccall unsafe "gtk_buttons_type_get_type"
gtk_buttons_type_get_type :: CULong
foreign import ccall unsafe "gtk_vbox_get_type"
gtk_vbox_get_type :: CULong