{-# LINE 2 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LINE 3 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
module Graphics.UI.Gtk.Windows.Window (
Window,
WindowClass,
castToWindow, gTypeWindow,
toWindow,
WindowType(..),
WindowEdge(..),
WindowTypeHint(..),
Gravity(..),
windowNew,
windowNewPopup,
windowActivateFocus,
windowActivateDefault,
windowSetDefaultSize,
windowGetDefaultSize,
windowSetPosition,
WindowPosition(..),
windowIsActive,
windowHasToplevelFocus,
windowListToplevels,
windowSetDefault,
windowGetDefaultWidget,
windowAddMnemonic,
windowRemoveMnemonic,
windowMnemonicActivate,
windowActivateKey,
windowPropagateKeyEvent,
windowPresent,
windowDeiconify,
windowIconify,
windowMaximize,
windowUnmaximize,
windowFullscreen,
windowUnfullscreen,
windowSetKeepAbove,
windowSetKeepBelow,
windowSetStartupId,
windowGetFrame,
windowSetFrameDimensions,
windowGetFrameDimensions,
windowStick,
windowUnstick,
windowAddAccelGroup,
windowRemoveAccelGroup,
windowSetDefaultIconList,
windowGetDefaultIconList,
windowSetDefaultIcon,
windowSetDefaultIconFromFile,
windowSetDefaultIconName,
windowGetDefaultIconName,
windowSetGravity,
windowGetGravity,
windowSetScreen,
windowGetScreen,
windowBeginResizeDrag,
windowBeginMoveDrag,
windowSetTypeHint,
windowGetTypeHint,
windowGetIcon,
windowGetPosition,
windowGetSize,
windowMove,
windowParseGeometry,
windowReshowWithInitialSize,
windowResize,
windowSetIconFromFile,
windowSetAutoStartupNotification,
windowPresentWithTime,
windowSetGeometryHints,
windowGetGroup,
windowGetWindowType,
windowTitle,
windowType,
windowAllowShrink,
windowAllowGrow,
windowResizable,
windowModal,
windowOpacity,
windowRole,
windowStartupId,
windowWindowPosition,
windowDefaultWidth,
windowDefaultHeight,
windowDeletable,
windowDestroyWithParent,
windowIcon,
windowIconName,
windowScreen,
windowTypeHint,
windowSkipTaskbarHint,
windowSkipPagerHint,
windowUrgencyHint,
windowAcceptFocus,
windowFocusOnMap,
windowDecorated,
windowGravity,
windowToplevelFocus,
windowTransientFor,
windowFocus,
windowHasFrame,
windowIconList,
windowMnemonicModifier,
windowMnemonicVisible,
frameEvent,
keysChanged,
setFocus,
windowSetTitle,
windowGetTitle,
windowSetResizable,
windowGetResizable,
windowSetModal,
windowGetModal,
windowSetPolicy,
windowSetTransientFor,
windowGetTransientFor,
windowSetDestroyWithParent,
windowGetDestroyWithParent,
windowGetFocus,
windowSetFocus,
windowSetMnemonicModifier,
windowGetMnemonicModifier,
windowSetSkipTaskbarHint,
windowGetSkipTaskbarHint,
windowSetSkipPagerHint,
windowGetSkipPagerHint,
windowSetAcceptFocus,
windowGetAcceptFocus,
windowSetFocusOnMap,
windowGetFocusOnMap,
windowSetDecorated,
windowGetDecorated,
windowSetDeletable,
windowGetDeletable,
windowSetHasFrame,
windowGetHasFrame,
windowSetRole,
windowGetRole,
windowSetIcon,
windowSetIconList,
windowGetIconList,
windowSetIconName,
windowGetIconName,
windowSetUrgencyHint,
windowGetUrgencyHint,
windowSetOpacity,
windowGetOpacity,
onSetFocus,
afterSetFocus
) where
import Control.Monad (liftM)
import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Flags
import System.Glib.GError
import System.Glib.Attributes
import System.Glib.Properties
import System.Glib.GList (fromGList, withGList)
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.General.Enums (WindowType(..), WindowPosition(..))
import Graphics.UI.Gtk.General.Structs (windowGetFrame)
import Graphics.UI.Gtk.Types
{-# LINE 295 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 296 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
import Graphics.UI.Gtk.Gdk.Enums (Modifier(..))
import Graphics.UI.Gtk.Gdk.Keys (KeyVal)
import Graphics.UI.Gtk.Gdk.EventM (EventM, EAny, EKey, MouseButton, TimeStamp)
import Control.Monad.Reader ( runReaderT, ask )
import Control.Monad.Trans ( liftIO )
import Graphics.UI.Gtk.Gdk.Enums (WindowEdge(..), WindowTypeHint(..),
Gravity(..))
{-# LINE 305 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
windowNew :: IO Window
windowNew :: IO Window
windowNew =
(ForeignPtr Window -> Window, FinalizerPtr Window)
-> IO (Ptr Window) -> IO Window
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Window -> Window, FinalizerPtr Window)
forall {a}. (ForeignPtr Window -> Window, FinalizerPtr a)
mkWindow (IO (Ptr Window) -> IO Window) -> IO (Ptr Window) -> IO Window
forall a b. (a -> b) -> a -> b
$
(Ptr Widget -> Ptr Window) -> IO (Ptr Widget) -> IO (Ptr Window)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Window
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Window) (IO (Ptr Widget) -> IO (Ptr Window))
-> IO (Ptr Widget) -> IO (Ptr Window)
forall a b. (a -> b) -> a -> b
$
CInt -> IO (Ptr Widget)
gtk_window_new
{-# LINE 316 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
((fromIntegral . fromEnum) WindowToplevel)
windowNewPopup :: IO Window
=
(ForeignPtr Window -> Window, FinalizerPtr Window)
-> IO (Ptr Window) -> IO Window
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Window -> Window, FinalizerPtr Window)
forall {a}. (ForeignPtr Window -> Window, FinalizerPtr a)
mkWindow (IO (Ptr Window) -> IO Window) -> IO (Ptr Window) -> IO Window
forall a b. (a -> b) -> a -> b
$
(Ptr Widget -> Ptr Window) -> IO (Ptr Widget) -> IO (Ptr Window)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Window
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Window) (IO (Ptr Widget) -> IO (Ptr Window))
-> IO (Ptr Widget) -> IO (Ptr Window)
forall a b. (a -> b) -> a -> b
$
CInt -> IO (Ptr Widget)
gtk_window_new
{-# LINE 325 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
((fromIntegral . fromEnum) WindowPopup)
windowSetTitle :: (WindowClass self, GlibString string) => self -> string -> IO ()
windowSetTitle :: forall self string.
(WindowClass self, GlibString string) =>
self -> string -> IO ()
windowSetTitle self
self string
title =
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
title ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
titlePtr ->
(\(Window ForeignPtr Window
arg1) CString
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CString -> IO ()
gtk_window_set_title Ptr Window
argPtr1 CString
arg2)
{-# LINE 341 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
CString
titlePtr
windowGetTitle :: (WindowClass self, GlibString string) => self -> IO string
windowGetTitle :: forall self string.
(WindowClass self, GlibString string) =>
self -> IO string
windowGetTitle self
self =
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CString) -> IO CString)
-> (Ptr Window -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CString
gtk_window_get_title Ptr Window
argPtr1)
{-# LINE 349 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
IO CString -> (CString -> IO string) -> IO string
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CString
strPtr -> if CString
strPtr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
then string -> IO string
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return string
""
else CString -> IO string
forall s. GlibString s => CString -> IO s
peekUTFString CString
strPtr
windowSetResizable :: WindowClass self => self -> Bool -> IO ()
windowSetResizable :: forall self. WindowClass self => self -> Bool -> IO ()
windowSetResizable self
self Bool
resizable =
(\(Window ForeignPtr Window
arg1) CInt
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> IO ()
gtk_window_set_resizable Ptr Window
argPtr1 CInt
arg2)
{-# LINE 360 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
resizable)
windowGetResizable :: WindowClass self => self
-> IO Bool
windowGetResizable :: forall self. WindowClass self => self -> IO Bool
windowGetResizable self
self =
(CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CInt
gtk_window_get_resizable Ptr Window
argPtr1)
{-# LINE 370 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
{-# LINE 390 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
windowActivateFocus :: WindowClass self => self
-> IO Bool
windowActivateFocus :: forall self. WindowClass self => self -> IO Bool
windowActivateFocus self
self =
(CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CInt
gtk_window_activate_focus Ptr Window
argPtr1)
{-# LINE 397 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowActivateDefault :: WindowClass self => self
-> IO Bool
windowActivateDefault :: forall self. WindowClass self => self -> IO Bool
windowActivateDefault self
self =
(CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CInt
gtk_window_activate_default Ptr Window
argPtr1)
{-# LINE 409 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
{-# DEPRECATED windowSetPolicy "Use windowSetResizable instead." #-}
windowSetPolicy :: WindowClass self => self -> Bool -> Bool -> Bool -> IO ()
windowSetPolicy :: forall self.
WindowClass self =>
self -> Bool -> Bool -> Bool -> IO ()
windowSetPolicy self
self Bool
allowShrink Bool
allowGrow Bool
autoShrink =
(\(Window ForeignPtr Window
arg1) CInt
arg2 CInt
arg3 CInt
arg4 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> CInt -> CInt -> IO ()
gtk_window_set_policy Ptr Window
argPtr1 CInt
arg2 CInt
arg3 CInt
arg4)
{-# LINE 423 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
allowShrink)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
allowGrow)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
autoShrink)
windowSetModal :: WindowClass self => self
-> Bool
-> IO ()
windowSetModal :: forall self. WindowClass self => self -> Bool -> IO ()
windowSetModal self
self Bool
modal =
(\(Window ForeignPtr Window
arg1) CInt
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> IO ()
gtk_window_set_modal Ptr Window
argPtr1 CInt
arg2)
{-# LINE 441 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
modal)
windowGetModal :: WindowClass self => self
-> IO Bool
windowGetModal :: forall self. WindowClass self => self -> IO Bool
windowGetModal self
self =
(CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CInt
gtk_window_get_modal Ptr Window
argPtr1)
{-# LINE 452 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowSetDefaultSize :: WindowClass self => self
-> Int
-> Int
-> IO ()
windowSetDefaultSize :: forall self. WindowClass self => self -> Int -> Int -> IO ()
windowSetDefaultSize self
self Int
height Int
width =
(\(Window ForeignPtr Window
arg1) CInt
arg2 CInt
arg3 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> CInt -> IO ()
gtk_window_set_default_size Ptr Window
argPtr1 CInt
arg2 CInt
arg3)
{-# LINE 488 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
windowAddMnemonic :: (WindowClass self, WidgetClass widget) => self
-> KeyVal
-> widget
-> IO ()
windowAddMnemonic :: forall self widget.
(WindowClass self, WidgetClass widget) =>
self -> KeyVal -> widget -> IO ()
windowAddMnemonic self
self KeyVal
keyval widget
target =
(\(Window ForeignPtr Window
arg1) CUInt
arg2 (Widget ForeignPtr Widget
arg3) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg3 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr3 ->Ptr Window -> CUInt -> Ptr Widget -> IO ()
gtk_window_add_mnemonic Ptr Window
argPtr1 CUInt
arg2 Ptr Widget
argPtr3)
{-# LINE 500 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(KeyVal -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral KeyVal
keyval)
(widget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget widget
target)
windowRemoveMnemonic :: (WindowClass self, WidgetClass widget) => self
-> KeyVal
-> widget
-> IO ()
windowRemoveMnemonic :: forall self widget.
(WindowClass self, WidgetClass widget) =>
self -> KeyVal -> widget -> IO ()
windowRemoveMnemonic self
self KeyVal
keyval widget
target =
(\(Window ForeignPtr Window
arg1) CUInt
arg2 (Widget ForeignPtr Widget
arg3) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg3 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr3 ->Ptr Window -> CUInt -> Ptr Widget -> IO ()
gtk_window_remove_mnemonic Ptr Window
argPtr1 CUInt
arg2 Ptr Widget
argPtr3)
{-# LINE 512 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(KeyVal -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral KeyVal
keyval)
(widget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget widget
target)
windowMnemonicActivate :: WindowClass self => self
-> KeyVal
-> [Modifier]
-> IO Bool
windowMnemonicActivate :: forall self.
WindowClass self =>
self -> KeyVal -> [Modifier] -> IO Bool
windowMnemonicActivate self
self KeyVal
keyval [Modifier]
modifier = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) CUInt
arg2 CInt
arg3 -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CUInt -> CInt -> IO CInt
gtk_window_mnemonic_activate Ptr Window
argPtr1 CUInt
arg2 CInt
arg3)
{-# LINE 523 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(KeyVal -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral KeyVal
keyval)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Modifier] -> Int
forall a. Flags a => [a] -> Int
fromFlags [Modifier]
modifier))
windowSetMnemonicModifier :: WindowClass self => self
-> [Modifier]
-> IO ()
windowSetMnemonicModifier :: forall self. WindowClass self => self -> [Modifier] -> IO ()
windowSetMnemonicModifier self
self [Modifier]
modifier =
(\(Window ForeignPtr Window
arg1) CInt
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> IO ()
gtk_window_set_mnemonic_modifier Ptr Window
argPtr1 CInt
arg2)
{-# LINE 533 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Modifier] -> Int
forall a. Flags a => [a] -> Int
fromFlags [Modifier]
modifier))
windowGetMnemonicModifier :: WindowClass self => self
-> IO [Modifier]
windowGetMnemonicModifier :: forall self. WindowClass self => self -> IO [Modifier]
windowGetMnemonicModifier self
self = (CInt -> [Modifier]) -> IO CInt -> IO [Modifier]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> [Modifier]
forall a. Flags a => Int -> [a]
toFlags (Int -> [Modifier]) -> (CInt -> Int) -> CInt -> [Modifier]
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 [Modifier]) -> IO CInt -> IO [Modifier]
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CInt
gtk_window_get_mnemonic_modifier Ptr Window
argPtr1)
{-# LINE 541 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowActivateKey :: WindowClass self => self -> EventM EKey Bool
windowActivateKey :: forall self. WindowClass self => self -> EventM EKey Bool
windowActivateKey self
self = do
Ptr EKey
ptr <- ReaderT (Ptr EKey) IO (Ptr EKey)
forall r (m :: * -> *). MonadReader r m => m r
ask
IO Bool -> EventM EKey Bool
forall a. IO a -> ReaderT (Ptr EKey) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> EventM EKey Bool) -> IO Bool -> EventM EKey Bool
forall a b. (a -> b) -> a -> b
$ (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) Ptr ()
arg2 -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> Ptr () -> IO CInt
gtk_window_activate_key Ptr Window
argPtr1 Ptr ()
arg2)
{-# LINE 553 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Ptr EKey -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr EKey
ptr)
windowPropagateKeyEvent :: WindowClass self => self
-> EventM EKey Bool
windowPropagateKeyEvent :: forall self. WindowClass self => self -> EventM EKey Bool
windowPropagateKeyEvent self
self = do
Ptr EKey
ptr <- ReaderT (Ptr EKey) IO (Ptr EKey)
forall r (m :: * -> *). MonadReader r m => m r
ask
IO Bool -> EventM EKey Bool
forall a. IO a -> ReaderT (Ptr EKey) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> EventM EKey Bool) -> IO Bool -> EventM EKey Bool
forall a b. (a -> b) -> a -> b
$ (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) Ptr ()
arg2 -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> Ptr () -> IO CInt
gtk_window_propagate_key_event Ptr Window
argPtr1 Ptr ()
arg2)
{-# LINE 567 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Ptr EKey -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr EKey
ptr)
windowGetDefaultSize :: WindowClass self => self
-> IO (Int, Int)
windowGetDefaultSize :: forall self. WindowClass self => self -> IO (Int, Int)
windowGetDefaultSize self
self =
(Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
widthPtr ->
(Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
heightPtr -> do
(\(Window ForeignPtr Window
arg1) Ptr CInt
arg2 Ptr CInt
arg3 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> Ptr CInt -> Ptr CInt -> IO ()
gtk_window_get_default_size Ptr Window
argPtr1 Ptr CInt
arg2 Ptr CInt
arg3)
{-# LINE 580 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
Ptr CInt
widthPtr
Ptr CInt
heightPtr
CInt
width <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
widthPtr
CInt
height <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
heightPtr
(Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
width, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
height)
windowSetPosition :: WindowClass self => self -> WindowPosition -> IO ()
windowSetPosition :: forall self. WindowClass self => self -> WindowPosition -> IO ()
windowSetPosition self
self WindowPosition
position =
(\(Window ForeignPtr Window
arg1) CInt
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> IO ()
gtk_window_set_position Ptr Window
argPtr1 CInt
arg2)
{-# LINE 594 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (WindowPosition -> Int) -> WindowPosition -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowPosition -> Int
forall a. Enum a => a -> Int
fromEnum) WindowPosition
position)
windowSetTransientFor :: (WindowClass self, WindowClass parent) => self
-> parent
-> IO ()
windowSetTransientFor :: forall self parent.
(WindowClass self, WindowClass parent) =>
self -> parent -> IO ()
windowSetTransientFor self
self parent
parent =
(\(Window ForeignPtr Window
arg1) (Window ForeignPtr Window
arg2) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg2 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr2 ->Ptr Window -> Ptr Window -> IO ()
gtk_window_set_transient_for Ptr Window
argPtr1 Ptr Window
argPtr2)
{-# LINE 615 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(parent -> Window
forall o. WindowClass o => o -> Window
toWindow parent
parent)
windowGetTransientFor :: WindowClass self => self
-> IO (Maybe Window)
windowGetTransientFor :: forall self. WindowClass self => self -> IO (Maybe Window)
windowGetTransientFor self
self =
(IO (Ptr Window) -> IO Window)
-> IO (Ptr Window) -> IO (Maybe Window)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr Window -> Window, FinalizerPtr Window)
-> IO (Ptr Window) -> IO Window
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Window -> Window, FinalizerPtr Window)
forall {a}. (ForeignPtr Window -> Window, FinalizerPtr a)
mkWindow) (IO (Ptr Window) -> IO (Maybe Window))
-> IO (Ptr Window) -> IO (Maybe Window)
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window
-> (Ptr Window -> IO (Ptr Window)) -> IO (Ptr Window)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO (Ptr Window)) -> IO (Ptr Window))
-> (Ptr Window -> IO (Ptr Window)) -> IO (Ptr Window)
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO (Ptr Window)
gtk_window_get_transient_for Ptr Window
argPtr1)
{-# LINE 627 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowSetDestroyWithParent :: WindowClass self => self -> Bool -> IO ()
windowSetDestroyWithParent :: forall self. WindowClass self => self -> Bool -> IO ()
windowSetDestroyWithParent self
self Bool
setting =
(\(Window ForeignPtr Window
arg1) CInt
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> IO ()
gtk_window_set_destroy_with_parent Ptr Window
argPtr1 CInt
arg2)
{-# LINE 637 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
setting)
windowGetDestroyWithParent :: WindowClass self => self
-> IO Bool
windowGetDestroyWithParent :: forall self. WindowClass self => self -> IO Bool
windowGetDestroyWithParent self
self =
(CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CInt
gtk_window_get_destroy_with_parent Ptr Window
argPtr1)
{-# LINE 649 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowIsActive :: WindowClass self => self
-> IO Bool
windowIsActive :: forall self. WindowClass self => self -> IO Bool
windowIsActive self
self =
(CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CInt
gtk_window_is_active Ptr Window
argPtr1)
{-# LINE 667 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowHasToplevelFocus :: WindowClass self => self
-> IO Bool
windowHasToplevelFocus :: forall self. WindowClass self => self -> IO Bool
windowHasToplevelFocus self
self =
(CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CInt
gtk_window_has_toplevel_focus Ptr Window
argPtr1)
{-# LINE 680 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowListToplevels :: IO [Window]
windowListToplevels :: IO [Window]
windowListToplevels = do
Ptr ()
glistPtr <- IO (Ptr ())
gtk_window_list_toplevels
{-# LINE 688 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
winPtrs <- fromGList glistPtr
(Ptr Window -> IO Window) -> [Ptr Window] -> IO [Window]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Ptr Window
ptr -> (ForeignPtr Window -> Window, FinalizerPtr Window)
-> IO (Ptr Window) -> IO Window
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr Window -> Window, FinalizerPtr Window)
forall {a}. (ForeignPtr Window -> Window, FinalizerPtr a)
mkWindow (Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
ptr)) [Ptr Window]
winPtrs
windowGetFocus :: WindowClass self => self -> IO (Maybe Widget)
windowGetFocus :: forall self. WindowClass self => self -> IO (Maybe Widget)
windowGetFocus self
self =
(IO (Ptr Widget) -> IO Widget)
-> IO (Ptr Widget) -> IO (Maybe Widget)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
forall {a}. (ForeignPtr Widget -> Widget, FinalizerPtr a)
mkWidget) (IO (Ptr Widget) -> IO (Maybe Widget))
-> IO (Ptr Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window
-> (Ptr Window -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((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
argPtr1 ->Ptr Window -> IO (Ptr Widget)
gtk_window_get_focus Ptr Window
argPtr1)
{-# LINE 700 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowSetFocus :: (WindowClass self, WidgetClass widget) => self
-> Maybe widget
-> IO ()
windowSetFocus :: forall self widget.
(WindowClass self, WidgetClass widget) =>
self -> Maybe widget -> IO ()
windowSetFocus self
self Maybe widget
focus =
(\(Window ForeignPtr Window
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
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 Window -> Ptr Widget -> IO ()
gtk_window_set_focus Ptr Window
argPtr1 Ptr Widget
argPtr2)
{-# LINE 713 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Widget -> (widget -> Widget) -> Maybe widget -> Widget
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ForeignPtr Widget -> Widget
Widget ForeignPtr Widget
forall a. ForeignPtr a
nullForeignPtr) widget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget Maybe widget
focus)
windowGetDefaultWidget :: WindowClass self => self
-> IO (Maybe Widget)
windowGetDefaultWidget :: forall self. WindowClass self => self -> IO (Maybe Widget)
windowGetDefaultWidget self
self =
(IO (Ptr Widget) -> IO Widget)
-> IO (Ptr Widget) -> IO (Maybe Widget)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
forall {a}. (ForeignPtr Widget -> Widget, FinalizerPtr a)
mkWidget) (IO (Ptr Widget) -> IO (Maybe Widget))
-> IO (Ptr Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window
-> (Ptr Window -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((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
argPtr1 ->Ptr Window -> IO (Ptr Widget)
gtk_window_get_default_widget Ptr Window
argPtr1)
{-# LINE 726 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowSetDefault :: (WindowClass self, WidgetClass widget) => self
-> Maybe widget
-> IO ()
windowSetDefault :: forall self widget.
(WindowClass self, WidgetClass widget) =>
self -> Maybe widget -> IO ()
windowSetDefault self
self Maybe widget
defaultWidget =
(\(Window ForeignPtr Window
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
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 Window -> Ptr Widget -> IO ()
gtk_window_set_focus Ptr Window
argPtr1 Ptr Widget
argPtr2)
{-# LINE 741 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Widget -> (widget -> Widget) -> Maybe widget -> Widget
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ForeignPtr Widget -> Widget
Widget ForeignPtr Widget
forall a. ForeignPtr a
nullForeignPtr) widget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget Maybe widget
defaultWidget)
windowPresent :: WindowClass self => self -> IO ()
windowPresent :: forall self. WindowClass self => self -> IO ()
windowPresent self
self =
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO ()
gtk_window_present Ptr Window
argPtr1)
{-# LINE 762 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowDeiconify :: WindowClass self => self -> IO ()
windowDeiconify :: forall self. WindowClass self => self -> IO ()
windowDeiconify self
self =
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO ()
gtk_window_deiconify Ptr Window
argPtr1)
{-# LINE 775 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowIconify :: WindowClass self => self -> IO ()
windowIconify :: forall self. WindowClass self => self -> IO ()
windowIconify self
self =
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO ()
gtk_window_iconify Ptr Window
argPtr1)
{-# LINE 793 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowMaximize :: WindowClass self => self -> IO ()
windowMaximize :: forall self. WindowClass self => self -> IO ()
windowMaximize self
self =
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO ()
gtk_window_maximize Ptr Window
argPtr1)
{-# LINE 810 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowUnmaximize :: WindowClass self => self -> IO ()
windowUnmaximize :: forall self. WindowClass self => self -> IO ()
windowUnmaximize self
self =
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO ()
gtk_window_unmaximize Ptr Window
argPtr1)
{-# LINE 824 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowFullscreen :: WindowClass self => self -> IO ()
windowFullscreen :: forall self. WindowClass self => self -> IO ()
windowFullscreen self
self =
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO ()
gtk_window_fullscreen Ptr Window
argPtr1)
{-# LINE 842 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowUnfullscreen :: WindowClass self => self -> IO ()
windowUnfullscreen :: forall self. WindowClass self => self -> IO ()
windowUnfullscreen self
self =
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO ()
gtk_window_unfullscreen Ptr Window
argPtr1)
{-# LINE 859 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowSetKeepAbove :: WindowClass self => self
-> Bool
-> IO ()
windowSetKeepAbove :: forall self. WindowClass self => self -> Bool -> IO ()
windowSetKeepAbove self
self Bool
setting =
(\(Window ForeignPtr Window
arg1) CInt
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> IO ()
gtk_window_set_keep_above Ptr Window
argPtr1 CInt
arg2)
{-# LINE 885 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
setting)
windowSetKeepBelow :: WindowClass self => self
-> Bool
-> IO ()
windowSetKeepBelow :: forall self. WindowClass self => self -> Bool -> IO ()
windowSetKeepBelow self
self Bool
setting =
(\(Window ForeignPtr Window
arg1) CInt
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> IO ()
gtk_window_set_keep_below Ptr Window
argPtr1 CInt
arg2)
{-# LINE 911 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
setting)
windowSetSkipTaskbarHint :: WindowClass self => self
-> Bool
-> IO ()
windowSetSkipTaskbarHint :: forall self. WindowClass self => self -> Bool -> IO ()
windowSetSkipTaskbarHint self
self Bool
setting =
(\(Window ForeignPtr Window
arg1) CInt
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> IO ()
gtk_window_set_skip_taskbar_hint Ptr Window
argPtr1 CInt
arg2)
{-# LINE 926 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
setting)
windowGetSkipTaskbarHint :: WindowClass self => self
-> IO Bool
windowGetSkipTaskbarHint :: forall self. WindowClass self => self -> IO Bool
windowGetSkipTaskbarHint self
self =
(CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CInt
gtk_window_get_skip_taskbar_hint Ptr Window
argPtr1)
{-# LINE 938 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowSetSkipPagerHint :: WindowClass self => self
-> Bool
-> IO ()
self
self Bool
setting =
(\(Window ForeignPtr Window
arg1) CInt
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> IO ()
gtk_window_set_skip_pager_hint Ptr Window
argPtr1 CInt
arg2)
{-# LINE 953 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
setting)
windowGetSkipPagerHint :: WindowClass self => self
-> IO Bool
self
self =
(CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CInt
gtk_window_get_skip_pager_hint Ptr Window
argPtr1)
{-# LINE 965 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowSetAcceptFocus :: WindowClass self => self
-> Bool
-> IO ()
windowSetAcceptFocus :: forall self. WindowClass self => self -> Bool -> IO ()
windowSetAcceptFocus self
self Bool
setting =
(\(Window ForeignPtr Window
arg1) CInt
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> IO ()
gtk_window_set_accept_focus Ptr Window
argPtr1 CInt
arg2)
{-# LINE 979 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
setting)
windowGetAcceptFocus :: WindowClass self => self
-> IO Bool
windowGetAcceptFocus :: forall self. WindowClass self => self -> IO Bool
windowGetAcceptFocus self
self =
(CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CInt
gtk_window_get_accept_focus Ptr Window
argPtr1)
{-# LINE 991 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowSetFocusOnMap :: WindowClass self => self
-> Bool
-> IO ()
windowSetFocusOnMap :: forall self. WindowClass self => self -> Bool -> IO ()
windowSetFocusOnMap self
self Bool
setting =
(\(Window ForeignPtr Window
arg1) CInt
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> IO ()
gtk_window_set_focus_on_map Ptr Window
argPtr1 CInt
arg2)
{-# LINE 1006 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
setting)
windowGetFocusOnMap :: WindowClass self => self
-> IO Bool
windowGetFocusOnMap :: forall self. WindowClass self => self -> IO Bool
windowGetFocusOnMap self
self =
(CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CInt
gtk_window_get_focus_on_map Ptr Window
argPtr1)
{-# LINE 1019 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowSetStartupId :: (WindowClass self, GlibString string) => self
-> string
-> IO ()
windowSetStartupId :: forall self string.
(WindowClass self, GlibString string) =>
self -> string -> IO ()
windowSetStartupId self
self string
startupId =
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
startupId ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
idPtr ->
(\(Window ForeignPtr Window
arg1) CString
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CString -> IO ()
gtk_window_set_startup_id Ptr Window
argPtr1 CString
arg2)
{-# LINE 1037 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
CString
idPtr
windowSetDecorated :: WindowClass self => self -> Bool -> IO ()
windowSetDecorated :: forall self. WindowClass self => self -> Bool -> IO ()
windowSetDecorated self
self Bool
setting =
(\(Window ForeignPtr Window
arg1) CInt
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> IO ()
gtk_window_set_decorated Ptr Window
argPtr1 CInt
arg2)
{-# LINE 1055 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
setting)
windowGetDecorated :: WindowClass self => self
-> IO Bool
windowGetDecorated :: forall self. WindowClass self => self -> IO Bool
windowGetDecorated self
self =
(CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CInt
gtk_window_get_decorated Ptr Window
argPtr1)
{-# LINE 1066 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowSetDeletable :: WindowClass self => self
-> Bool
-> IO ()
windowSetDeletable :: forall self. WindowClass self => self -> Bool -> IO ()
windowSetDeletable self
self Bool
setting =
(\(Window ForeignPtr Window
arg1) CInt
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> IO ()
gtk_window_set_deletable Ptr Window
argPtr1 CInt
arg2)
{-# LINE 1085 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
setting)
windowGetDeletable :: WindowClass self => self
-> IO Bool
windowGetDeletable :: forall self. WindowClass self => self -> IO Bool
windowGetDeletable self
self = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CInt
gtk_window_get_deletable Ptr Window
argPtr1)
{-# LINE 1096 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowSetFrameDimensions :: WindowClass self => self
-> Int
-> Int
-> Int
-> Int
-> IO ()
windowSetFrameDimensions :: forall self.
WindowClass self =>
self -> Int -> Int -> Int -> Int -> IO ()
windowSetFrameDimensions self
self Int
left Int
top Int
right Int
bottom =
(\(Window ForeignPtr Window
arg1) CInt
arg2 CInt
arg3 CInt
arg4 CInt
arg5 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> CInt -> CInt -> CInt -> IO ()
gtk_window_set_frame_dimensions Ptr Window
argPtr1 CInt
arg2 CInt
arg3 CInt
arg4 CInt
arg5)
{-# LINE 1118 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
left)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
top)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
right)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bottom)
windowGetFrameDimensions :: WindowClass self => self
-> IO (Int, Int, Int, Int)
windowGetFrameDimensions :: forall self. WindowClass self => self -> IO (Int, Int, Int, Int)
windowGetFrameDimensions self
self =
(Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int))
-> (Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
lPtr -> (Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int))
-> (Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
tPtr -> (Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int))
-> (Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
rPtr -> (Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int))
-> (Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
bPtr -> do
(\(Window ForeignPtr Window
arg1) Ptr CInt
arg2 Ptr CInt
arg3 Ptr CInt
arg4 Ptr CInt
arg5 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
gtk_window_get_frame_dimensions Ptr Window
argPtr1 Ptr CInt
arg2 Ptr CInt
arg3 Ptr CInt
arg4 Ptr CInt
arg5) (self -> Window
forall o. WindowClass o => o -> Window
toWindow self
self) Ptr CInt
lPtr Ptr CInt
tPtr Ptr CInt
rPtr Ptr CInt
bPtr
CInt
lv <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
lPtr
CInt
tv <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
tPtr
CInt
rv <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
rPtr
CInt
bv <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
bPtr
(Int, Int, Int, Int) -> IO (Int, Int, Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
lv, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
tv, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
rv, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
bv)
windowSetHasFrame :: WindowClass self => self
-> Bool
-> IO ()
windowSetHasFrame :: forall self. WindowClass self => self -> Bool -> IO ()
windowSetHasFrame self
self Bool
setting =
(\(Window ForeignPtr Window
arg1) CInt
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> IO ()
gtk_window_set_has_frame Ptr Window
argPtr1 CInt
arg2)
{-# LINE 1166 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
setting)
windowGetHasFrame :: WindowClass self => self
-> IO Bool
windowGetHasFrame :: forall self. WindowClass self => self -> IO Bool
windowGetHasFrame self
self = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CInt
gtk_window_get_has_frame Ptr Window
argPtr1)
{-# LINE 1176 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowSetRole :: (WindowClass self, GlibString string) => self
-> string
-> IO ()
windowSetRole :: forall self string.
(WindowClass self, GlibString string) =>
self -> string -> IO ()
windowSetRole self
self string
role =
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
role ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
rolePtr ->
(\(Window ForeignPtr Window
arg1) CString
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CString -> IO ()
gtk_window_set_role Ptr Window
argPtr1 CString
arg2)
{-# LINE 1199 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
CString
rolePtr
windowGetRole :: (WindowClass self, GlibString string) => self
-> IO (Maybe string)
windowGetRole :: forall self string.
(WindowClass self, GlibString string) =>
self -> IO (Maybe string)
windowGetRole self
self =
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CString) -> IO CString)
-> (Ptr Window -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CString
gtk_window_get_role Ptr Window
argPtr1)
{-# LINE 1210 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
IO CString -> (CString -> IO (Maybe string)) -> IO (Maybe string)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CString -> IO string) -> CString -> IO (Maybe string)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek CString -> IO string
forall s. GlibString s => CString -> IO s
peekUTFString
windowStick :: WindowClass self => self -> IO ()
windowStick :: forall self. WindowClass self => self -> IO ()
windowStick self
self =
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO ()
gtk_window_stick Ptr Window
argPtr1)
{-# LINE 1229 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowUnstick :: WindowClass self => self -> IO ()
windowUnstick :: forall self. WindowClass self => self -> IO ()
windowUnstick self
self =
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO ()
gtk_window_unstick Ptr Window
argPtr1)
{-# LINE 1243 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowAddAccelGroup :: WindowClass self => self
-> AccelGroup
-> IO ()
windowAddAccelGroup :: forall self. WindowClass self => self -> AccelGroup -> IO ()
windowAddAccelGroup self
self AccelGroup
accelGroup =
(\(Window ForeignPtr Window
arg1) (AccelGroup ForeignPtr AccelGroup
arg2) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->ForeignPtr AccelGroup -> (Ptr AccelGroup -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr AccelGroup
arg2 ((Ptr AccelGroup -> IO ()) -> IO ())
-> (Ptr AccelGroup -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AccelGroup
argPtr2 ->Ptr Window -> Ptr AccelGroup -> IO ()
gtk_window_add_accel_group Ptr Window
argPtr1 Ptr AccelGroup
argPtr2)
{-# LINE 1254 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
AccelGroup
accelGroup
windowRemoveAccelGroup :: WindowClass self => self
-> AccelGroup
-> IO ()
windowRemoveAccelGroup :: forall self. WindowClass self => self -> AccelGroup -> IO ()
windowRemoveAccelGroup self
self AccelGroup
accelGroup =
(\(Window ForeignPtr Window
arg1) (AccelGroup ForeignPtr AccelGroup
arg2) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->ForeignPtr AccelGroup -> (Ptr AccelGroup -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr AccelGroup
arg2 ((Ptr AccelGroup -> IO ()) -> IO ())
-> (Ptr AccelGroup -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AccelGroup
argPtr2 ->Ptr Window -> Ptr AccelGroup -> IO ()
gtk_window_remove_accel_group Ptr Window
argPtr1 Ptr AccelGroup
argPtr2)
{-# LINE 1264 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
AccelGroup
accelGroup
windowSetIcon :: WindowClass self => self
-> Maybe Pixbuf
-> IO ()
windowSetIcon :: forall self. WindowClass self => self -> Maybe Pixbuf -> IO ()
windowSetIcon self
self Maybe Pixbuf
Nothing =
(\(Window ForeignPtr Window
arg1) (Pixbuf ForeignPtr Pixbuf
arg2) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg2 ((Ptr Pixbuf -> IO ()) -> IO ()) -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr2 ->Ptr Window -> Ptr Pixbuf -> IO ()
gtk_window_set_icon Ptr Window
argPtr1 Ptr Pixbuf
argPtr2)
{-# LINE 1291 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(ForeignPtr Pixbuf -> Pixbuf
Pixbuf ForeignPtr Pixbuf
forall a. ForeignPtr a
nullForeignPtr)
windowSetIcon self
self (Just Pixbuf
icon) =
(\(Window ForeignPtr Window
arg1) (Pixbuf ForeignPtr Pixbuf
arg2) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg2 ((Ptr Pixbuf -> IO ()) -> IO ()) -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr2 ->Ptr Window -> Ptr Pixbuf -> IO ()
gtk_window_set_icon Ptr Window
argPtr1 Ptr Pixbuf
argPtr2)
{-# LINE 1295 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
Pixbuf
icon
windowGetIcon :: WindowClass self => self
-> IO (Maybe Pixbuf)
windowGetIcon :: forall self. WindowClass self => self -> IO (Maybe Pixbuf)
windowGetIcon self
self =
(IO (Ptr Pixbuf) -> IO Pixbuf)
-> IO (Ptr Pixbuf) -> IO (Maybe Pixbuf)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf) (IO (Ptr Pixbuf) -> IO (Maybe Pixbuf))
-> IO (Ptr Pixbuf) -> IO (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window
-> (Ptr Window -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr Window -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO (Ptr Pixbuf)
gtk_window_get_icon Ptr Window
argPtr1)
{-# LINE 1306 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowSetIconList :: WindowClass self => self
-> [Pixbuf]
-> IO ()
windowSetIconList :: forall self. WindowClass self => self -> [Pixbuf] -> IO ()
windowSetIconList self
self [Pixbuf]
list =
[ForeignPtr Pixbuf] -> ([Ptr Pixbuf] -> IO ()) -> IO ()
forall a b. [ForeignPtr a] -> ([Ptr a] -> IO b) -> IO b
withForeignPtrs ((Pixbuf -> ForeignPtr Pixbuf) -> [Pixbuf] -> [ForeignPtr Pixbuf]
forall a b. (a -> b) -> [a] -> [b]
map Pixbuf -> ForeignPtr Pixbuf
unPixbuf [Pixbuf]
list) (([Ptr Pixbuf] -> IO ()) -> IO ())
-> ([Ptr Pixbuf] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Ptr Pixbuf]
ptrList ->
[Ptr Pixbuf] -> (Ptr () -> IO ()) -> IO ()
forall a b. [Ptr a] -> (Ptr () -> IO b) -> IO b
withGList [Ptr Pixbuf]
ptrList ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ()
glist ->
(\(Window ForeignPtr Window
arg1) Ptr ()
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> Ptr () -> IO ()
gtk_window_set_icon_list Ptr Window
argPtr1 Ptr ()
arg2)
{-# LINE 1332 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
Ptr ()
glist
windowGetIconList :: WindowClass self => self
-> IO [Pixbuf]
windowGetIconList :: forall self. WindowClass self => self -> IO [Pixbuf]
windowGetIconList self
self = do
Ptr ()
glist <- (\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr Window -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO (Ptr ())
gtk_window_get_icon_list Ptr Window
argPtr1) (self -> Window
forall o. WindowClass o => o -> Window
toWindow self
self)
[Ptr Pixbuf]
ptrList <- Ptr () -> IO [Ptr Pixbuf]
forall a. Ptr () -> IO [Ptr a]
fromGList Ptr ()
glist
(Ptr Pixbuf -> IO Pixbuf) -> [Ptr Pixbuf] -> IO [Pixbuf]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (IO (Ptr Pixbuf) -> IO Pixbuf)
-> (Ptr Pixbuf -> IO (Ptr Pixbuf)) -> Ptr Pixbuf -> IO Pixbuf
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Pixbuf -> IO (Ptr Pixbuf)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return) [Ptr Pixbuf]
ptrList
windowSetDefaultIconList :: [Pixbuf] -> IO ()
windowSetDefaultIconList :: [Pixbuf] -> IO ()
windowSetDefaultIconList [Pixbuf]
list =
[ForeignPtr Pixbuf] -> ([Ptr Pixbuf] -> IO ()) -> IO ()
forall a b. [ForeignPtr a] -> ([Ptr a] -> IO b) -> IO b
withForeignPtrs ((Pixbuf -> ForeignPtr Pixbuf) -> [Pixbuf] -> [ForeignPtr Pixbuf]
forall a b. (a -> b) -> [a] -> [b]
map Pixbuf -> ForeignPtr Pixbuf
unPixbuf [Pixbuf]
list) (([Ptr Pixbuf] -> IO ()) -> IO ())
-> ([Ptr Pixbuf] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Ptr Pixbuf]
ptrList ->
[Ptr Pixbuf] -> (Ptr () -> IO ()) -> IO ()
forall a b. [Ptr a] -> (Ptr () -> IO b) -> IO b
withGList [Ptr Pixbuf]
ptrList ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ()
glist ->
Ptr () -> IO ()
gtk_window_set_default_icon_list Ptr ()
glist
windowGetDefaultIconList :: IO [Pixbuf]
windowGetDefaultIconList :: IO [Pixbuf]
windowGetDefaultIconList = do
Ptr ()
glist <- IO (Ptr ())
gtk_window_get_default_icon_list
{-# LINE 1360 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
ptrList <- fromGList glist
(Ptr Pixbuf -> IO Pixbuf) -> [Ptr Pixbuf] -> IO [Pixbuf]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (IO (Ptr Pixbuf) -> IO Pixbuf)
-> (Ptr Pixbuf -> IO (Ptr Pixbuf)) -> Ptr Pixbuf -> IO Pixbuf
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Pixbuf -> IO (Ptr Pixbuf)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return) [Ptr Pixbuf]
ptrList
windowSetIconName :: (WindowClass self, GlibString string) => self
-> string
-> IO ()
windowSetIconName :: forall self string.
(WindowClass self, GlibString string) =>
self -> string -> IO ()
windowSetIconName self
self string
name =
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
name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
namePtr ->
(\(Window ForeignPtr Window
arg1) CString
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CString -> IO ()
gtk_window_set_icon_name Ptr Window
argPtr1 CString
arg2)
{-# LINE 1379 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
CString
namePtr
windowGetIconName :: (WindowClass self, GlibString string) => self
-> IO string
windowGetIconName :: forall self string.
(WindowClass self, GlibString string) =>
self -> IO string
windowGetIconName self
self =
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CString) -> IO CString)
-> (Ptr Window -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CString
gtk_window_get_icon_name Ptr Window
argPtr1)
{-# LINE 1392 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
IO CString -> (CString -> IO string) -> IO string
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CString
strPtr -> if CString
strPtr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
then string -> IO string
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return string
""
else CString -> IO string
forall s. GlibString s => CString -> IO s
peekUTFString CString
strPtr
windowSetDefaultIconName :: GlibString string
=> string
-> IO ()
windowSetDefaultIconName :: forall string. GlibString string => string -> IO ()
windowSetDefaultIconName string
name =
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
name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
namePtr ->
CString -> IO ()
gtk_window_set_default_icon_name
{-# LINE 1410 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
namePtr
windowSetDefaultIcon :: Maybe Pixbuf -> IO ()
windowSetDefaultIcon :: Maybe Pixbuf -> IO ()
windowSetDefaultIcon (Just Pixbuf
icon) =
(\(Pixbuf ForeignPtr Pixbuf
arg1) -> ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO ()) -> IO ()) -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf -> IO ()
gtk_window_set_default_icon Ptr Pixbuf
argPtr1) Pixbuf
icon
windowSetDefaultIcon Maybe Pixbuf
Nothing =
(\(Pixbuf ForeignPtr Pixbuf
arg1) -> ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO ()) -> IO ()) -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf -> IO ()
gtk_window_set_default_icon Ptr Pixbuf
argPtr1) (ForeignPtr Pixbuf -> Pixbuf
Pixbuf ForeignPtr Pixbuf
forall a. ForeignPtr a
nullForeignPtr)
windowSetDefaultIconFromFile :: GlibString string
=> string
-> IO Bool
windowSetDefaultIconFromFile :: forall string. GlibString string => string -> IO Bool
windowSetDefaultIconFromFile string
filename =
(CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(Ptr (Ptr ()) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr ()) -> IO a) -> IO a
propagateGError ((Ptr (Ptr ()) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr ()) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
errPtr ->
string -> (CString -> IO CInt) -> IO CInt
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
filename ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CString
filenamePtr ->
CString -> Ptr (Ptr ()) -> IO CInt
gtk_window_set_default_icon_from_file
{-# LINE 1440 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
filenamePtr
Ptr (Ptr ())
errPtr
windowGetDefaultIconName :: GlibString string
=> IO string
windowGetDefaultIconName :: forall string. GlibString string => IO string
windowGetDefaultIconName =
IO CString
gtk_window_get_default_icon_name
{-# LINE 1454 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
>>= peekUTFString
windowSetScreen :: WindowClass self => self
-> Screen
-> IO ()
windowSetScreen :: forall self. WindowClass self => self -> Screen -> IO ()
windowSetScreen self
self Screen
screen =
(\(Window ForeignPtr Window
arg1) (Screen ForeignPtr Screen
arg2) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->ForeignPtr Screen -> (Ptr Screen -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Screen
arg2 ((Ptr Screen -> IO ()) -> IO ()) -> (Ptr Screen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Screen
argPtr2 ->Ptr Window -> Ptr Screen -> IO ()
gtk_window_set_screen Ptr Window
argPtr1 Ptr Screen
argPtr2)
{-# LINE 1468 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
Screen
screen
windowGetScreen :: WindowClass self => self
-> IO Screen
windowGetScreen :: forall self. WindowClass self => self -> IO Screen
windowGetScreen self
self =
(ForeignPtr Screen -> Screen, FinalizerPtr Screen)
-> IO (Ptr Screen) -> IO Screen
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr Screen -> Screen, FinalizerPtr Screen)
forall {a}. (ForeignPtr Screen -> Screen, FinalizerPtr a)
mkScreen (IO (Ptr Screen) -> IO Screen) -> IO (Ptr Screen) -> IO Screen
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window
-> (Ptr Window -> IO (Ptr Screen)) -> IO (Ptr Screen)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO (Ptr Screen)) -> IO (Ptr Screen))
-> (Ptr Window -> IO (Ptr Screen)) -> IO (Ptr Screen)
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO (Ptr Screen)
gtk_window_get_screen Ptr Window
argPtr1)
{-# LINE 1480 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowSetIconFromFile :: (WindowClass self, GlibFilePath fp) => self
-> fp
-> IO ()
windowSetIconFromFile :: forall self fp.
(WindowClass self, GlibFilePath fp) =>
self -> fp -> IO ()
windowSetIconFromFile self
self fp
filename =
(Ptr (Ptr ()) -> IO ()) -> IO ()
forall a. (Ptr (Ptr ()) -> IO a) -> IO a
propagateGError ((Ptr (Ptr ()) -> IO ()) -> IO ())
-> (Ptr (Ptr ()) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
errPtr ->
fp -> (CString -> IO ()) -> IO ()
forall a. fp -> (CString -> IO a) -> IO a
forall fp a. GlibFilePath fp => fp -> (CString -> IO a) -> IO a
withUTFFilePath fp
filename ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
filenamePtr -> do
(\(Window ForeignPtr Window
arg1) CString
arg2 Ptr (Ptr ())
arg3 -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CString -> Ptr (Ptr ()) -> IO CInt
gtk_window_set_icon_from_file Ptr Window
argPtr1 CString
arg2 Ptr (Ptr ())
arg3)
{-# LINE 1501 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(self -> Window
forall o. WindowClass o => o -> Window
toWindow self
self)
CString
filenamePtr
Ptr (Ptr ())
errPtr
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
windowSetAutoStartupNotification ::
Bool
-> IO ()
windowSetAutoStartupNotification :: Bool -> IO ()
windowSetAutoStartupNotification Bool
setting =
CInt -> IO ()
gtk_window_set_auto_startup_notification
{-# LINE 1524 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(fromBool setting)
windowSetGravity :: WindowClass self => self
-> Gravity
-> IO ()
windowSetGravity :: forall self. WindowClass self => self -> Gravity -> IO ()
windowSetGravity self
self Gravity
gravity =
(\(Window ForeignPtr Window
arg1) CInt
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> IO ()
gtk_window_set_gravity Ptr Window
argPtr1 CInt
arg2)
{-# LINE 1538 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Gravity -> Int) -> Gravity -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gravity -> Int
forall a. Enum a => a -> Int
fromEnum) Gravity
gravity)
windowGetGravity :: WindowClass self => self
-> IO Gravity
windowGetGravity :: forall self. WindowClass self => self -> IO Gravity
windowGetGravity self
self =
(CInt -> Gravity) -> IO CInt -> IO Gravity
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Gravity
forall a. Enum a => Int -> a
toEnum (Int -> Gravity) -> (CInt -> Int) -> CInt -> Gravity
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 Gravity) -> IO CInt -> IO Gravity
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CInt
gtk_window_get_gravity Ptr Window
argPtr1)
{-# LINE 1548 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowMove :: WindowClass self => self
-> Int
-> Int
-> IO ()
windowMove :: forall self. WindowClass self => self -> Int -> Int -> IO ()
windowMove self
self Int
x Int
y =
(\(Window ForeignPtr Window
arg1) CInt
arg2 CInt
arg3 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> CInt -> IO ()
gtk_window_move Ptr Window
argPtr1 CInt
arg2 CInt
arg3)
{-# LINE 1587 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)
windowParseGeometry :: (WindowClass self, GlibString string) => self
-> string
-> IO Bool
windowParseGeometry :: forall self string.
(WindowClass self, GlibString string) =>
self -> string -> IO Bool
windowParseGeometry self
self string
geometry = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
string -> (CString -> IO CInt) -> IO CInt
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
geometry ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CString
geometryPtr ->
(\(Window ForeignPtr Window
arg1) CString
arg2 -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CString -> IO CInt
gtk_window_parse_geometry Ptr Window
argPtr1 CString
arg2)
{-# LINE 1610 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
CString
geometryPtr
windowReshowWithInitialSize :: WindowClass self => self -> IO ()
windowReshowWithInitialSize :: forall self. WindowClass self => self -> IO ()
windowReshowWithInitialSize self
self =
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO ()
gtk_window_reshow_with_initial_size Ptr Window
argPtr1) (self -> Window
forall o. WindowClass o => o -> Window
toWindow self
self)
windowResize :: WindowClass self => self
-> Int
-> Int
-> IO ()
windowResize :: forall self. WindowClass self => self -> Int -> Int -> IO ()
windowResize self
self Int
width Int
height =
(\(Window ForeignPtr Window
arg1) CInt
arg2 CInt
arg3 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> CInt -> IO ()
gtk_window_resize Ptr Window
argPtr1 CInt
arg2 CInt
arg3)
{-# LINE 1635 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
windowBeginResizeDrag :: WindowClass self => self
-> WindowEdge
-> MouseButton
-> Int
-> Int
-> TimeStamp
-> IO ()
windowBeginResizeDrag :: forall self.
WindowClass self =>
self -> WindowEdge -> MouseButton -> Int -> Int -> KeyVal -> IO ()
windowBeginResizeDrag self
self WindowEdge
edge MouseButton
button Int
rootX Int
rootY KeyVal
timestamp =
(\(Window ForeignPtr Window
arg1) CInt
arg2 CInt
arg3 CInt
arg4 CInt
arg5 CUInt
arg6 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> CInt -> CInt -> CInt -> CUInt -> IO ()
gtk_window_begin_resize_drag Ptr Window
argPtr1 CInt
arg2 CInt
arg3 CInt
arg4 CInt
arg5 CUInt
arg6)
{-# LINE 1657 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (WindowEdge -> Int) -> WindowEdge -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowEdge -> Int
forall a. Enum a => a -> Int
fromEnum) WindowEdge
edge)
((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (MouseButton -> Int) -> MouseButton -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MouseButton -> Int
forall a. Enum a => a -> Int
fromEnum) MouseButton
button)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rootX)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rootY)
(KeyVal -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral KeyVal
timestamp)
windowBeginMoveDrag :: WindowClass self => self
-> MouseButton
-> Int
-> Int
-> TimeStamp
-> IO ()
windowBeginMoveDrag :: forall self.
WindowClass self =>
self -> MouseButton -> Int -> Int -> KeyVal -> IO ()
windowBeginMoveDrag self
self MouseButton
button Int
rootX Int
rootY KeyVal
timestamp =
(\(Window ForeignPtr Window
arg1) CInt
arg2 CInt
arg3 CInt
arg4 CUInt
arg5 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> CInt -> CInt -> CUInt -> IO ()
gtk_window_begin_move_drag Ptr Window
argPtr1 CInt
arg2 CInt
arg3 CInt
arg4 CUInt
arg5)
{-# LINE 1681 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (MouseButton -> Int) -> MouseButton -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MouseButton -> Int
forall a. Enum a => a -> Int
fromEnum) MouseButton
button)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rootX)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rootY)
(KeyVal -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral KeyVal
timestamp)
windowGetPosition :: WindowClass self => self
-> IO (Int, Int)
windowGetPosition :: forall self. WindowClass self => self -> IO (Int, Int)
windowGetPosition self
self =
(Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
rootXPtr ->
(Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
rootYPtr -> do
(\(Window ForeignPtr Window
arg1) Ptr CInt
arg2 Ptr CInt
arg3 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> Ptr CInt -> Ptr CInt -> IO ()
gtk_window_get_position Ptr Window
argPtr1 Ptr CInt
arg2 Ptr CInt
arg3)
{-# LINE 1723 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
Ptr CInt
rootXPtr
Ptr CInt
rootYPtr
CInt
rootX <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
rootXPtr
CInt
rootY <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
rootYPtr
(Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
rootX, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
rootY)
windowGetSize :: WindowClass self => self
-> IO (Int, Int)
windowGetSize :: forall self. WindowClass self => self -> IO (Int, Int)
windowGetSize self
self =
(Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
widthPtr ->
(Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
heightPtr -> do
(\(Window ForeignPtr Window
arg1) Ptr CInt
arg2 Ptr CInt
arg3 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> Ptr CInt -> Ptr CInt -> IO ()
gtk_window_get_size Ptr Window
argPtr1 Ptr CInt
arg2 Ptr CInt
arg3)
{-# LINE 1774 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
Ptr CInt
widthPtr
Ptr CInt
heightPtr
CInt
width <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
widthPtr
CInt
height <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
heightPtr
(Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
width, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
height)
windowSetTypeHint :: WindowClass self => self
-> WindowTypeHint
-> IO ()
windowSetTypeHint :: forall self. WindowClass self => self -> WindowTypeHint -> IO ()
windowSetTypeHint self
self WindowTypeHint
hint =
(\(Window ForeignPtr Window
arg1) CInt
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> IO ()
gtk_window_set_type_hint Ptr Window
argPtr1 CInt
arg2)
{-# LINE 1792 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (WindowTypeHint -> Int) -> WindowTypeHint -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowTypeHint -> Int
forall a. Enum a => a -> Int
fromEnum) WindowTypeHint
hint)
windowGetTypeHint :: WindowClass self => self
-> IO WindowTypeHint
windowGetTypeHint :: forall self. WindowClass self => self -> IO WindowTypeHint
windowGetTypeHint self
self =
(CInt -> WindowTypeHint) -> IO CInt -> IO WindowTypeHint
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> WindowTypeHint
forall a. Enum a => Int -> a
toEnum (Int -> WindowTypeHint) -> (CInt -> Int) -> CInt -> WindowTypeHint
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 WindowTypeHint) -> IO CInt -> IO WindowTypeHint
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CInt
gtk_window_get_type_hint Ptr Window
argPtr1)
{-# LINE 1802 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowPresentWithTime :: WindowClass self => self
-> TimeStamp
-> IO ()
windowPresentWithTime :: forall self. WindowClass self => self -> KeyVal -> IO ()
windowPresentWithTime self
self KeyVal
timestamp =
(\(Window ForeignPtr Window
arg1) CUInt
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CUInt -> IO ()
gtk_window_present_with_time Ptr Window
argPtr1 CUInt
arg2)
{-# LINE 1818 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(KeyVal -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral KeyVal
timestamp)
windowSetUrgencyHint :: WindowClass self => self
-> Bool
-> IO ()
windowSetUrgencyHint :: forall self. WindowClass self => self -> Bool -> IO ()
windowSetUrgencyHint self
self Bool
setting =
(\(Window ForeignPtr Window
arg1) CInt
arg2 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> CInt -> IO ()
gtk_window_set_urgency_hint Ptr Window
argPtr1 CInt
arg2)
{-# LINE 1831 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
setting)
windowGetUrgencyHint :: WindowClass self => self
-> IO Bool
windowGetUrgencyHint :: forall self. WindowClass self => self -> IO Bool
windowGetUrgencyHint self
self =
(CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Window ForeignPtr Window
arg1) -> ForeignPtr Window -> (Ptr Window -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO CInt) -> IO CInt)
-> (Ptr Window -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Window
argPtr1 ->Ptr Window -> IO CInt
gtk_window_get_urgency_hint Ptr Window
argPtr1)
{-# LINE 1843 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowSetGeometryHints :: (WindowClass self, WidgetClass widget) =>
self
-> Maybe widget
-> Maybe (Int, Int)
-> Maybe (Int, Int)
-> Maybe (Int, Int)
-> Maybe (Int, Int)
-> Maybe (Double, Double)
-> IO ()
windowSetGeometryHints :: forall self widget.
(WindowClass self, WidgetClass widget) =>
self
-> Maybe widget
-> Maybe (Int, Int)
-> Maybe (Int, Int)
-> Maybe (Int, Int)
-> Maybe (Int, Int)
-> Maybe (Double, Double)
-> IO ()
windowSetGeometryHints self
self Maybe widget
geometryWidget
Maybe (Int, Int)
minSize Maybe (Int, Int)
maxSize Maybe (Int, Int)
baseSize Maybe (Int, Int)
incSize Maybe (Double, Double)
aspect =
Int -> (Ptr () -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
52 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ()
geometryPtr -> do
Int
minSizeFlag <- case Maybe (Int, Int)
minSize of
Maybe (Int, Int)
Nothing -> Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
Just (Int
width, Int
height) -> do
(\Ptr ()
ptr CInt
val -> do {Ptr () -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ()
ptr Int
0 (CInt
val::CInt)}) Ptr ()
geometryPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
(\Ptr ()
ptr CInt
val -> do {Ptr () -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ()
ptr Int
4 (CInt
val::CInt)}) Ptr ()
geometryPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GdkWindowHints -> Int
forall a. Enum a => a -> Int
fromEnum GdkWindowHints
GdkHintMinSize)
Int
maxSizeFlag <- case Maybe (Int, Int)
maxSize of
Maybe (Int, Int)
Nothing -> Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
Just (Int
width, Int
height) -> do
(\Ptr ()
ptr CInt
val -> do {Ptr () -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ()
ptr Int
8 (CInt
val::CInt)}) Ptr ()
geometryPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
(\Ptr ()
ptr CInt
val -> do {Ptr () -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ()
ptr Int
12 (CInt
val::CInt)}) Ptr ()
geometryPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GdkWindowHints -> Int
forall a. Enum a => a -> Int
fromEnum GdkWindowHints
GdkHintMaxSize)
Int
baseSizeFlag <- case Maybe (Int, Int)
baseSize of
Maybe (Int, Int)
Nothing -> Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
Just (Int
width, Int
height) -> do
(\Ptr ()
ptr CInt
val -> do {Ptr () -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ()
ptr Int
16 (CInt
val::CInt)}) Ptr ()
geometryPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
(\Ptr ()
ptr CInt
val -> do {Ptr () -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ()
ptr Int
20 (CInt
val::CInt)}) Ptr ()
geometryPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GdkWindowHints -> Int
forall a. Enum a => a -> Int
fromEnum GdkWindowHints
GdkHintBaseSize)
Int
incSizeFlag <- case Maybe (Int, Int)
incSize of
Maybe (Int, Int)
Nothing -> Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
Just (Int
width, Int
height) -> do
(\Ptr ()
ptr CInt
val -> do {Ptr () -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ()
ptr Int
24 (CInt
val::CInt)}) Ptr ()
geometryPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
(\Ptr ()
ptr CInt
val -> do {Ptr () -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ()
ptr Int
28 (CInt
val::CInt)}) Ptr ()
geometryPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GdkWindowHints -> Int
forall a. Enum a => a -> Int
fromEnum GdkWindowHints
GdkHintResizeInc)
Int
aspectFlag <- case Maybe (Double, Double)
aspect of
Maybe (Double, Double)
Nothing -> Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
Just (Double
min, Double
max) -> do
(\Ptr ()
ptr CDouble
val -> do {Ptr () -> Int -> CDouble -> IO ()
forall b. Ptr b -> Int -> CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ()
ptr Int
32 (CDouble
val::CDouble)}) Ptr ()
geometryPtr (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
min)
(\Ptr ()
ptr CDouble
val -> do {Ptr () -> Int -> CDouble -> IO ()
forall b. Ptr b -> Int -> CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ()
ptr Int
40 (CDouble
val::CDouble)}) Ptr ()
geometryPtr (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
max)
Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GdkWindowHints -> Int
forall a. Enum a => a -> Int
fromEnum GdkWindowHints
GdkHintAspect)
(\(Window ForeignPtr Window
arg1) (Widget ForeignPtr Widget
arg2) Ptr ()
arg3 CInt
arg4 -> ForeignPtr Window -> (Ptr Window -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Window
arg1 ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Window
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 Window -> Ptr Widget -> Ptr () -> CInt -> IO ()
gtk_window_set_geometry_hints Ptr Window
argPtr1 Ptr Widget
argPtr2 Ptr ()
arg3 CInt
arg4)
{-# LINE 1934 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Widget -> (widget -> Widget) -> Maybe widget -> Widget
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ForeignPtr Widget -> Widget
Widget ForeignPtr Widget
forall a. ForeignPtr a
nullForeignPtr) widget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget Maybe widget
geometryWidget)
Ptr ()
geometryPtr
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Int
minSizeFlag Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
maxSizeFlag Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
baseSizeFlag
Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
incSizeFlag Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
aspectFlag)
data GdkWindowHints = GdkHintPos
| GdkHintMinSize
| GdkHintMaxSize
| GdkHintBaseSize
| GdkHintAspect
| GdkHintResizeInc
| GdkHintWinGravity
| GdkHintUserPos
| GdkHintUserSize
instance Enum GdkWindowHints where
fromEnum :: GdkWindowHints -> Int
fromEnum GdkWindowHints
GdkHintPos = Int
1
fromEnum GdkWindowHints
GdkHintMinSize = Int
2
fromEnum GdkWindowHints
GdkHintMaxSize = Int
4
fromEnum GdkHintBaseSize = 8
fromEnum GdkHintAspect = 16
fromEnum GdkHintResizeInc = 32
fromEnum GdkHintWinGravity = 64
fromEnum GdkHintUserPos = 128
fromEnum GdkWindowHints
GdkHintUserSize = Int
256
toEnum 1 = GdkHintPos
toEnum 2 = GdkHintMinSize
toEnum 4 = GdkHintMaxSize
toEnum 8 = GdkHintBaseSize
toEnum 16 = GdkHintAspect
toEnum 32 = GdkHintResizeInc
toEnum 64 = GdkHintWinGravity
toEnum 128 = GdkHintUserPos
toEnum 256 = GdkHintUserSize
toEnum unmatched = error ("GdkWindowHints.toEnum: Cannot match " ++ show unmatched)
succ GdkHintPos = GdkHintMinSize
succ GdkHintMinSize = GdkHintMaxSize
succ GdkHintMaxSize = GdkHintBaseSize
succ GdkHintBaseSize = GdkHintAspect
succ GdkHintAspect = GdkHintResizeInc
succ GdkHintResizeInc = GdkHintWinGravity
succ GdkHintWinGravity = GdkHintUserPos
succ GdkHintUserPos = GdkHintUserSize
succ _ = undefined
pred :: GdkWindowHints -> GdkWindowHints
pred GdkWindowHints
GdkHintMinSize = GdkWindowHints
GdkHintPos
pred GdkWindowHints
GdkHintMaxSize = GdkWindowHints
GdkHintMinSize
pred GdkHintBaseSize = GdkHintMaxSize
pred GdkHintAspect = GdkHintBaseSize
pred GdkHintResizeInc = GdkHintAspect
pred GdkWindowHints
GdkHintWinGravity = GdkWindowHints
GdkHintResizeInc
pred GdkHintUserPos = GdkHintWinGravity
pred GdkHintUserSize = GdkHintUserPos
pred GdkWindowHints
_ = GdkWindowHints
forall a. HasCallStack => a
undefined
enumFromTo :: GdkWindowHints -> GdkWindowHints -> [GdkWindowHints]
enumFromTo GdkWindowHints
x GdkWindowHints
y | GdkWindowHints -> Int
forall a. Enum a => a -> Int
fromEnum GdkWindowHints
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== GdkWindowHints -> Int
forall a. Enum a => a -> Int
fromEnum GdkWindowHints
y = [ GdkWindowHints
y ]
| Bool
otherwise = GdkWindowHints
x GdkWindowHints -> [GdkWindowHints] -> [GdkWindowHints]
forall a. a -> [a] -> [a]
: GdkWindowHints -> GdkWindowHints -> [GdkWindowHints]
forall a. Enum a => a -> a -> [a]
enumFromTo (GdkWindowHints -> GdkWindowHints
forall a. Enum a => a -> a
succ GdkWindowHints
x) GdkWindowHints
y
enumFrom :: GdkWindowHints -> [GdkWindowHints]
enumFrom GdkWindowHints
x = GdkWindowHints -> GdkWindowHints -> [GdkWindowHints]
forall a. Enum a => a -> a -> [a]
enumFromTo GdkWindowHints
x GdkWindowHints
GdkHintUserSize
enumFromThen :: GdkWindowHints -> GdkWindowHints -> [GdkWindowHints]
enumFromThen GdkWindowHints
_ GdkWindowHints
_ = FilePath -> [GdkWindowHints]
forall a. HasCallStack => FilePath -> a
error FilePath
"Enum GdkWindowHints: enumFromThen not implemented"
enumFromThenTo :: GdkWindowHints
-> GdkWindowHints -> GdkWindowHints -> [GdkWindowHints]
enumFromThenTo GdkWindowHints
_ GdkWindowHints
_ GdkWindowHints
_ = FilePath -> [GdkWindowHints]
forall a. HasCallStack => FilePath -> a
error FilePath
"Enum GdkWindowHints: enumFromThenTo not implemented"
{-# LINE 1941 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
windowSetOpacity :: WindowClass self => self
-> Double
-> IO ()
windowSetOpacity self opacity =
(\(Window arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_window_set_opacity argPtr1 arg2) (toWindow self) (realToFrac opacity)
windowGetOpacity :: WindowClass self => self
-> IO Double
windowGetOpacity self = liftM realToFrac $
(\(Window arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_window_get_opacity argPtr1) (toWindow self)
windowGetGroup :: WindowClass self => Maybe self
-> IO WindowGroup
windowGetGroup self =
makeNewGObject mkWindowGroup $
(\(Window arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_window_get_group argPtr1) (maybe (Window nullForeignPtr) toWindow self)
windowGetWindowType :: WindowClass self => self
-> IO WindowType
windowGetWindowType self =
liftM (toEnum . fromIntegral) $
(\(Window arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_window_get_window_type argPtr1)
{-# LINE 1993 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
windowTitle :: (WindowClass self, GlibString string) => Attr self string
windowTitle :: forall self string.
(WindowClass self, GlibString string) =>
Attr self string
windowTitle = (self -> IO string)
-> (self -> string -> IO ()) -> ReadWriteAttr self string string
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO string
forall self string.
(WindowClass self, GlibString string) =>
self -> IO string
windowGetTitle
self -> string -> IO ()
forall self string.
(WindowClass self, GlibString string) =>
self -> string -> IO ()
windowSetTitle
windowType :: WindowClass self => ReadAttr self WindowType
windowType :: forall self. WindowClass self => ReadAttr self WindowType
windowType = FilePath -> CUInt -> ReadAttr self WindowType
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
FilePath -> CUInt -> ReadAttr gobj enum
readAttrFromEnumProperty FilePath
"type"
CUInt
gtk_window_type_get_type
{-# LINE 2013 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
windowAllowShrink :: WindowClass self => Attr self Bool
windowAllowShrink :: forall self. WindowClass self => Attr self Bool
windowAllowShrink = FilePath -> Attr self Bool
forall gobj. GObjectClass gobj => FilePath -> Attr gobj Bool
newAttrFromBoolProperty FilePath
"allow-shrink"
windowAllowGrow :: WindowClass self => Attr self Bool
windowAllowGrow :: forall self. WindowClass self => Attr self Bool
windowAllowGrow = FilePath -> Attr self Bool
forall gobj. GObjectClass gobj => FilePath -> Attr gobj Bool
newAttrFromBoolProperty FilePath
"allow-grow"
windowResizable :: WindowClass self => Attr self Bool
windowResizable :: forall self. WindowClass self => Attr self Bool
windowResizable = (self -> IO Bool)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Bool Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO Bool
forall self. WindowClass self => self -> IO Bool
windowGetResizable
self -> Bool -> IO ()
forall self. WindowClass self => self -> Bool -> IO ()
windowSetResizable
{-# LINE 2049 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
windowModal :: WindowClass self => Attr self Bool
windowModal :: forall self. WindowClass self => Attr self Bool
windowModal = (self -> IO Bool)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Bool Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO Bool
forall self. WindowClass self => self -> IO Bool
windowGetModal
self -> Bool -> IO ()
forall self. WindowClass self => self -> Bool -> IO ()
windowSetModal
windowOpacity :: WindowClass self => Attr self Double
windowOpacity :: forall self. WindowClass self => Attr self Double
windowOpacity = FilePath -> Attr self Double
forall gobj. GObjectClass gobj => FilePath -> Attr gobj Double
newAttrFromDoubleProperty FilePath
"opacity"
windowFocus :: WindowClass self => Attr self (Maybe Widget)
windowFocus :: forall self. WindowClass self => Attr self (Maybe Widget)
windowFocus = (self -> IO (Maybe Widget))
-> (self -> Maybe Widget -> IO ())
-> ReadWriteAttr self (Maybe Widget) (Maybe Widget)
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO (Maybe Widget)
forall self. WindowClass self => self -> IO (Maybe Widget)
windowGetFocus
self -> Maybe Widget -> IO ()
forall self widget.
(WindowClass self, WidgetClass widget) =>
self -> Maybe widget -> IO ()
windowSetFocus
windowHasFrame :: WindowClass self => Attr self Bool
windowHasFrame :: forall self. WindowClass self => Attr self Bool
windowHasFrame = (self -> IO Bool)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Bool Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO Bool
forall self. WindowClass self => self -> IO Bool
windowGetHasFrame
self -> Bool -> IO ()
forall self. WindowClass self => self -> Bool -> IO ()
windowSetHasFrame
windowIconList :: WindowClass self => Attr self [Pixbuf]
windowIconList :: forall self. WindowClass self => Attr self [Pixbuf]
windowIconList = (self -> IO [Pixbuf])
-> (self -> [Pixbuf] -> IO ())
-> ReadWriteAttr self [Pixbuf] [Pixbuf]
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO [Pixbuf]
forall self. WindowClass self => self -> IO [Pixbuf]
windowGetIconList
self -> [Pixbuf] -> IO ()
forall self. WindowClass self => self -> [Pixbuf] -> IO ()
windowSetIconList
windowMnemonicModifier :: WindowClass self => Attr self [Modifier]
windowMnemonicModifier :: forall self. WindowClass self => Attr self [Modifier]
windowMnemonicModifier = (self -> IO [Modifier])
-> (self -> [Modifier] -> IO ())
-> ReadWriteAttr self [Modifier] [Modifier]
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO [Modifier]
forall self. WindowClass self => self -> IO [Modifier]
windowGetMnemonicModifier
self -> [Modifier] -> IO ()
forall self. WindowClass self => self -> [Modifier] -> IO ()
windowSetMnemonicModifier
windowMnemonicVisible :: WindowClass self => Attr self Bool
windowMnemonicVisible :: forall self. WindowClass self => Attr self Bool
windowMnemonicVisible = FilePath -> Attr self Bool
forall gobj. GObjectClass gobj => FilePath -> Attr gobj Bool
newAttrFromBoolProperty FilePath
"mnemonics-visible"
windowRole :: (WindowClass self, GlibString string) => Attr self string
windowRole :: forall self string.
(WindowClass self, GlibString string) =>
Attr self string
windowRole = FilePath -> Attr self string
forall gobj string.
(GObjectClass gobj, GlibString string) =>
FilePath -> Attr gobj string
newAttrFromStringProperty FilePath
"role"
windowStartupId :: (WindowClass self, GlibString string) => Attr self string
windowStartupId :: forall self string.
(WindowClass self, GlibString string) =>
Attr self string
windowStartupId = FilePath -> Attr self string
forall gobj string.
(GObjectClass gobj, GlibString string) =>
FilePath -> Attr gobj string
newAttrFromStringProperty FilePath
"startup-id"
windowWindowPosition :: WindowClass self => Attr self WindowPosition
windowWindowPosition :: forall self. WindowClass self => Attr self WindowPosition
windowWindowPosition = FilePath -> CUInt -> Attr self WindowPosition
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
FilePath -> CUInt -> Attr gobj enum
newAttrFromEnumProperty FilePath
"window-position"
CUInt
gtk_window_position_get_type
{-# LINE 2165 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
windowDefaultWidth :: WindowClass self => Attr self Int
windowDefaultWidth :: forall self. WindowClass self => Attr self Int
windowDefaultWidth = FilePath -> Attr self Int
forall gobj. GObjectClass gobj => FilePath -> Attr gobj Int
newAttrFromIntProperty FilePath
"default-width"
windowDefaultHeight :: WindowClass self => Attr self Int
windowDefaultHeight :: forall self. WindowClass self => Attr self Int
windowDefaultHeight = FilePath -> Attr self Int
forall gobj. GObjectClass gobj => FilePath -> Attr gobj Int
newAttrFromIntProperty FilePath
"default-height"
windowDeletable :: WindowClass self => Attr self Bool
windowDeletable :: forall self. WindowClass self => Attr self Bool
windowDeletable = FilePath -> Attr self Bool
forall gobj. GObjectClass gobj => FilePath -> Attr gobj Bool
newAttrFromBoolProperty FilePath
"deletable"
windowDestroyWithParent :: WindowClass self => Attr self Bool
windowDestroyWithParent :: forall self. WindowClass self => Attr self Bool
windowDestroyWithParent = (self -> IO Bool)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Bool Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO Bool
forall self. WindowClass self => self -> IO Bool
windowGetDestroyWithParent
self -> Bool -> IO ()
forall self. WindowClass self => self -> Bool -> IO ()
windowSetDestroyWithParent
windowIcon :: WindowClass self => Attr self (Maybe Pixbuf)
windowIcon :: forall self. WindowClass self => Attr self (Maybe Pixbuf)
windowIcon = (self -> IO (Maybe Pixbuf))
-> (self -> Maybe Pixbuf -> IO ())
-> ReadWriteAttr self (Maybe Pixbuf) (Maybe Pixbuf)
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO (Maybe Pixbuf)
forall self. WindowClass self => self -> IO (Maybe Pixbuf)
windowGetIcon
self -> Maybe Pixbuf -> IO ()
forall self. WindowClass self => self -> Maybe Pixbuf -> IO ()
windowSetIcon
windowIconName :: (WindowClass self, GlibString string) => Attr self string
windowIconName :: forall self string.
(WindowClass self, GlibString string) =>
Attr self string
windowIconName = FilePath -> Attr self string
forall gobj string.
(GObjectClass gobj, GlibString string) =>
FilePath -> Attr gobj string
newAttrFromStringProperty FilePath
"icon-name"
windowScreen :: WindowClass self => Attr self Screen
windowScreen :: forall self. WindowClass self => Attr self Screen
windowScreen = (self -> IO Screen)
-> (self -> Screen -> IO ()) -> ReadWriteAttr self Screen Screen
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO Screen
forall self. WindowClass self => self -> IO Screen
windowGetScreen
self -> Screen -> IO ()
forall self. WindowClass self => self -> Screen -> IO ()
windowSetScreen
windowTypeHint :: WindowClass self => Attr self WindowTypeHint
windowTypeHint :: forall self. WindowClass self => Attr self WindowTypeHint
windowTypeHint = (self -> IO WindowTypeHint)
-> (self -> WindowTypeHint -> IO ())
-> ReadWriteAttr self WindowTypeHint WindowTypeHint
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO WindowTypeHint
forall self. WindowClass self => self -> IO WindowTypeHint
windowGetTypeHint
self -> WindowTypeHint -> IO ()
forall self. WindowClass self => self -> WindowTypeHint -> IO ()
windowSetTypeHint
windowSkipTaskbarHint :: WindowClass self => Attr self Bool
windowSkipTaskbarHint :: forall self. WindowClass self => Attr self Bool
windowSkipTaskbarHint = (self -> IO Bool)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Bool Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO Bool
forall self. WindowClass self => self -> IO Bool
windowGetSkipTaskbarHint
self -> Bool -> IO ()
forall self. WindowClass self => self -> Bool -> IO ()
windowSetSkipTaskbarHint
windowSkipPagerHint :: WindowClass self => Attr self Bool
= (self -> IO Bool)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Bool Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO Bool
forall self. WindowClass self => self -> IO Bool
windowGetSkipPagerHint
self -> Bool -> IO ()
forall self. WindowClass self => self -> Bool -> IO ()
windowSetSkipPagerHint
windowUrgencyHint :: WindowClass self => Attr self Bool
windowUrgencyHint :: forall self. WindowClass self => Attr self Bool
windowUrgencyHint = (self -> IO Bool)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Bool Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO Bool
forall self. WindowClass self => self -> IO Bool
windowGetUrgencyHint
self -> Bool -> IO ()
forall self. WindowClass self => self -> Bool -> IO ()
windowSetUrgencyHint
windowAcceptFocus :: WindowClass self => Attr self Bool
windowAcceptFocus :: forall self. WindowClass self => Attr self Bool
windowAcceptFocus = (self -> IO Bool)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Bool Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO Bool
forall self. WindowClass self => self -> IO Bool
windowGetAcceptFocus
self -> Bool -> IO ()
forall self. WindowClass self => self -> Bool -> IO ()
windowSetAcceptFocus
windowFocusOnMap :: WindowClass self => Attr self Bool
windowFocusOnMap :: forall self. WindowClass self => Attr self Bool
windowFocusOnMap = (self -> IO Bool)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Bool Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO Bool
forall self. WindowClass self => self -> IO Bool
windowGetFocusOnMap
self -> Bool -> IO ()
forall self. WindowClass self => self -> Bool -> IO ()
windowSetFocusOnMap
windowDecorated :: WindowClass self => Attr self Bool
windowDecorated :: forall self. WindowClass self => Attr self Bool
windowDecorated = (self -> IO Bool)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Bool Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO Bool
forall self. WindowClass self => self -> IO Bool
windowGetDecorated
self -> Bool -> IO ()
forall self. WindowClass self => self -> Bool -> IO ()
windowSetDecorated
windowGravity :: WindowClass self => Attr self Gravity
windowGravity :: forall self. WindowClass self => Attr self Gravity
windowGravity = (self -> IO Gravity)
-> (self -> Gravity -> IO ()) -> ReadWriteAttr self Gravity Gravity
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO Gravity
forall self. WindowClass self => self -> IO Gravity
windowGetGravity
self -> Gravity -> IO ()
forall self. WindowClass self => self -> Gravity -> IO ()
windowSetGravity
windowToplevelFocus :: WindowClass self => Attr self Bool
windowToplevelFocus :: forall self. WindowClass self => Attr self Bool
windowToplevelFocus = FilePath -> Attr self Bool
forall gobj. GObjectClass gobj => FilePath -> Attr gobj Bool
newAttrFromBoolProperty FilePath
"has-toplevel-focus"
windowTransientFor :: (WindowClass self, WindowClass parent) => ReadWriteAttr self (Maybe Window) parent
windowTransientFor :: forall self parent.
(WindowClass self, WindowClass parent) =>
ReadWriteAttr self (Maybe Window) parent
windowTransientFor = (self -> IO (Maybe Window))
-> (self -> parent -> IO ())
-> ReadWriteAttr self (Maybe Window) parent
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO (Maybe Window)
forall self. WindowClass self => self -> IO (Maybe Window)
windowGetTransientFor
self -> parent -> IO ()
forall self parent.
(WindowClass self, WindowClass parent) =>
self -> parent -> IO ()
windowSetTransientFor
frameEvent :: WindowClass self => Signal self (EventM EAny Bool)
frameEvent :: forall self. WindowClass self => Signal self (EventM EAny Bool)
frameEvent = (Bool -> self -> EventM EAny Bool -> IO (ConnectId self))
-> Signal self (EventM EAny Bool)
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (\Bool
after self
obj EventM EAny Bool
fun ->
FilePath
-> Bool -> self -> (Ptr EAny -> IO Bool) -> IO (ConnectId self)
forall obj a.
GObjectClass obj =>
FilePath -> Bool -> obj -> (Ptr a -> IO Bool) -> IO (ConnectId obj)
connect_PTR__BOOL FilePath
"frame-event" Bool
after self
obj (EventM EAny Bool -> Ptr EAny -> IO Bool
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT EventM EAny Bool
fun))
keysChanged :: WindowClass self => Signal self (IO ())
keysChanged :: forall self. WindowClass self => Signal self (IO ())
keysChanged = (Bool -> self -> IO () -> IO (ConnectId self))
-> Signal self (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (FilePath -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
FilePath -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE FilePath
"keys-changed")
setFocus :: WindowClass self => Signal self (Maybe Widget -> IO ())
setFocus :: forall self.
WindowClass self =>
Signal self (Maybe Widget -> IO ())
setFocus = (Bool -> self -> (Maybe Widget -> IO ()) -> IO (ConnectId self))
-> Signal self (Maybe Widget -> IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (FilePath
-> Bool -> self -> (Maybe Widget -> IO ()) -> IO (ConnectId self)
forall a' obj.
(GObjectClass a', GObjectClass obj) =>
FilePath
-> Bool -> obj -> (Maybe a' -> IO ()) -> IO (ConnectId obj)
connect_MOBJECT__NONE FilePath
"set-focus")
onSetFocus, afterSetFocus :: (WindowClass self, WidgetClass foc) => self
-> (Maybe foc -> IO ())
-> IO (ConnectId self)
onSetFocus :: forall self foc.
(WindowClass self, WidgetClass foc) =>
self -> (Maybe foc -> IO ()) -> IO (ConnectId self)
onSetFocus = FilePath
-> Bool -> self -> (Maybe foc -> IO ()) -> IO (ConnectId self)
forall a' obj.
(GObjectClass a', GObjectClass obj) =>
FilePath
-> Bool -> obj -> (Maybe a' -> IO ()) -> IO (ConnectId obj)
connect_MOBJECT__NONE FilePath
"set-focus" Bool
False
afterSetFocus :: forall self foc.
(WindowClass self, WidgetClass foc) =>
self -> (Maybe foc -> IO ()) -> IO (ConnectId self)
afterSetFocus = FilePath
-> Bool -> self -> (Maybe foc -> IO ()) -> IO (ConnectId self)
forall a' obj.
(GObjectClass a', GObjectClass obj) =>
FilePath
-> Bool -> obj -> (Maybe a' -> IO ()) -> IO (ConnectId obj)
connect_MOBJECT__NONE FilePath
"set-focus" Bool
True
foreign import ccall safe "gtk_window_new"
gtk_window_new :: (CInt -> (IO (Ptr Widget)))
foreign import ccall safe "gtk_window_set_title"
gtk_window_set_title :: ((Ptr Window) -> ((Ptr CChar) -> (IO ())))
foreign import ccall safe "gtk_window_get_title"
gtk_window_get_title :: ((Ptr Window) -> (IO (Ptr CChar)))
foreign import ccall safe "gtk_window_set_resizable"
gtk_window_set_resizable :: ((Ptr Window) -> (CInt -> (IO ())))
foreign import ccall unsafe "gtk_window_get_resizable"
gtk_window_get_resizable :: ((Ptr Window) -> (IO CInt))
foreign import ccall safe "gtk_window_activate_focus"
gtk_window_activate_focus :: ((Ptr Window) -> (IO CInt))
foreign import ccall safe "gtk_window_activate_default"
gtk_window_activate_default :: ((Ptr Window) -> (IO CInt))
foreign import ccall safe "gtk_window_set_policy"
gtk_window_set_policy :: ((Ptr Window) -> (CInt -> (CInt -> (CInt -> (IO ())))))
foreign import ccall safe "gtk_window_set_modal"
gtk_window_set_modal :: ((Ptr Window) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_window_get_modal"
gtk_window_get_modal :: ((Ptr Window) -> (IO CInt))
foreign import ccall safe "gtk_window_set_default_size"
gtk_window_set_default_size :: ((Ptr Window) -> (CInt -> (CInt -> (IO ()))))
foreign import ccall safe "gtk_window_add_mnemonic"
gtk_window_add_mnemonic :: ((Ptr Window) -> (CUInt -> ((Ptr Widget) -> (IO ()))))
foreign import ccall safe "gtk_window_remove_mnemonic"
gtk_window_remove_mnemonic :: ((Ptr Window) -> (CUInt -> ((Ptr Widget) -> (IO ()))))
foreign import ccall safe "gtk_window_mnemonic_activate"
gtk_window_mnemonic_activate :: ((Ptr Window) -> (CUInt -> (CInt -> (IO CInt))))
foreign import ccall safe "gtk_window_set_mnemonic_modifier"
gtk_window_set_mnemonic_modifier :: ((Ptr Window) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_window_get_mnemonic_modifier"
gtk_window_get_mnemonic_modifier :: ((Ptr Window) -> (IO CInt))
foreign import ccall safe "gtk_window_activate_key"
gtk_window_activate_key :: ((Ptr Window) -> ((Ptr ()) -> (IO CInt)))
foreign import ccall safe "gtk_window_propagate_key_event"
gtk_window_propagate_key_event :: ((Ptr Window) -> ((Ptr ()) -> (IO CInt)))
foreign import ccall safe "gtk_window_get_default_size"
gtk_window_get_default_size :: ((Ptr Window) -> ((Ptr CInt) -> ((Ptr CInt) -> (IO ()))))
foreign import ccall safe "gtk_window_set_position"
gtk_window_set_position :: ((Ptr Window) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_window_set_transient_for"
gtk_window_set_transient_for :: ((Ptr Window) -> ((Ptr Window) -> (IO ())))
foreign import ccall safe "gtk_window_get_transient_for"
gtk_window_get_transient_for :: ((Ptr Window) -> (IO (Ptr Window)))
foreign import ccall safe "gtk_window_set_destroy_with_parent"
gtk_window_set_destroy_with_parent :: ((Ptr Window) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_window_get_destroy_with_parent"
gtk_window_get_destroy_with_parent :: ((Ptr Window) -> (IO CInt))
foreign import ccall safe "gtk_window_is_active"
gtk_window_is_active :: ((Ptr Window) -> (IO CInt))
foreign import ccall safe "gtk_window_has_toplevel_focus"
gtk_window_has_toplevel_focus :: ((Ptr Window) -> (IO CInt))
foreign import ccall unsafe "gtk_window_list_toplevels"
gtk_window_list_toplevels :: (IO (Ptr ()))
foreign import ccall unsafe "gtk_window_get_focus"
gtk_window_get_focus :: ((Ptr Window) -> (IO (Ptr Widget)))
foreign import ccall unsafe "gtk_window_set_focus"
gtk_window_set_focus :: ((Ptr Window) -> ((Ptr Widget) -> (IO ())))
foreign import ccall safe "gtk_window_get_default_widget"
gtk_window_get_default_widget :: ((Ptr Window) -> (IO (Ptr Widget)))
foreign import ccall safe "gtk_window_present"
gtk_window_present :: ((Ptr Window) -> (IO ()))
foreign import ccall safe "gtk_window_deiconify"
gtk_window_deiconify :: ((Ptr Window) -> (IO ()))
foreign import ccall safe "gtk_window_iconify"
gtk_window_iconify :: ((Ptr Window) -> (IO ()))
foreign import ccall safe "gtk_window_maximize"
gtk_window_maximize :: ((Ptr Window) -> (IO ()))
foreign import ccall safe "gtk_window_unmaximize"
gtk_window_unmaximize :: ((Ptr Window) -> (IO ()))
foreign import ccall safe "gtk_window_fullscreen"
gtk_window_fullscreen :: ((Ptr Window) -> (IO ()))
foreign import ccall safe "gtk_window_unfullscreen"
gtk_window_unfullscreen :: ((Ptr Window) -> (IO ()))
foreign import ccall safe "gtk_window_set_keep_above"
gtk_window_set_keep_above :: ((Ptr Window) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_window_set_keep_below"
gtk_window_set_keep_below :: ((Ptr Window) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_window_set_skip_taskbar_hint"
gtk_window_set_skip_taskbar_hint :: ((Ptr Window) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_window_get_skip_taskbar_hint"
gtk_window_get_skip_taskbar_hint :: ((Ptr Window) -> (IO CInt))
foreign import ccall safe "gtk_window_set_skip_pager_hint"
:: ((Ptr Window) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_window_get_skip_pager_hint"
:: ((Ptr Window) -> (IO CInt))
foreign import ccall safe "gtk_window_set_accept_focus"
gtk_window_set_accept_focus :: ((Ptr Window) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_window_get_accept_focus"
gtk_window_get_accept_focus :: ((Ptr Window) -> (IO CInt))
foreign import ccall safe "gtk_window_set_focus_on_map"
gtk_window_set_focus_on_map :: ((Ptr Window) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_window_get_focus_on_map"
gtk_window_get_focus_on_map :: ((Ptr Window) -> (IO CInt))
foreign import ccall safe "gtk_window_set_startup_id"
gtk_window_set_startup_id :: ((Ptr Window) -> ((Ptr CChar) -> (IO ())))
foreign import ccall safe "gtk_window_set_decorated"
gtk_window_set_decorated :: ((Ptr Window) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_window_get_decorated"
gtk_window_get_decorated :: ((Ptr Window) -> (IO CInt))
foreign import ccall safe "gtk_window_set_deletable"
gtk_window_set_deletable :: ((Ptr Window) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_window_get_deletable"
gtk_window_get_deletable :: ((Ptr Window) -> (IO CInt))
foreign import ccall safe "gtk_window_set_frame_dimensions"
gtk_window_set_frame_dimensions :: ((Ptr Window) -> (CInt -> (CInt -> (CInt -> (CInt -> (IO ()))))))
foreign import ccall safe "gtk_window_get_frame_dimensions"
gtk_window_get_frame_dimensions :: ((Ptr Window) -> ((Ptr CInt) -> ((Ptr CInt) -> ((Ptr CInt) -> ((Ptr CInt) -> (IO ()))))))
foreign import ccall safe "gtk_window_set_has_frame"
gtk_window_set_has_frame :: ((Ptr Window) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_window_get_has_frame"
gtk_window_get_has_frame :: ((Ptr Window) -> (IO CInt))
foreign import ccall safe "gtk_window_set_role"
gtk_window_set_role :: ((Ptr Window) -> ((Ptr CChar) -> (IO ())))
foreign import ccall safe "gtk_window_get_role"
gtk_window_get_role :: ((Ptr Window) -> (IO (Ptr CChar)))
foreign import ccall safe "gtk_window_stick"
gtk_window_stick :: ((Ptr Window) -> (IO ()))
foreign import ccall safe "gtk_window_unstick"
gtk_window_unstick :: ((Ptr Window) -> (IO ()))
foreign import ccall safe "gtk_window_add_accel_group"
gtk_window_add_accel_group :: ((Ptr Window) -> ((Ptr AccelGroup) -> (IO ())))
foreign import ccall safe "gtk_window_remove_accel_group"
gtk_window_remove_accel_group :: ((Ptr Window) -> ((Ptr AccelGroup) -> (IO ())))
foreign import ccall safe "gtk_window_set_icon"
gtk_window_set_icon :: ((Ptr Window) -> ((Ptr Pixbuf) -> (IO ())))
foreign import ccall safe "gtk_window_get_icon"
gtk_window_get_icon :: ((Ptr Window) -> (IO (Ptr Pixbuf)))
foreign import ccall safe "gtk_window_set_icon_list"
gtk_window_set_icon_list :: ((Ptr Window) -> ((Ptr ()) -> (IO ())))
foreign import ccall safe "gtk_window_get_icon_list"
gtk_window_get_icon_list :: ((Ptr Window) -> (IO (Ptr ())))
foreign import ccall safe "gtk_window_set_default_icon_list"
gtk_window_set_default_icon_list :: ((Ptr ()) -> (IO ()))
foreign import ccall safe "gtk_window_get_default_icon_list"
gtk_window_get_default_icon_list :: (IO (Ptr ()))
foreign import ccall safe "gtk_window_set_icon_name"
gtk_window_set_icon_name :: ((Ptr Window) -> ((Ptr CChar) -> (IO ())))
foreign import ccall safe "gtk_window_get_icon_name"
gtk_window_get_icon_name :: ((Ptr Window) -> (IO (Ptr CChar)))
foreign import ccall safe "gtk_window_set_default_icon_name"
gtk_window_set_default_icon_name :: ((Ptr CChar) -> (IO ()))
foreign import ccall safe "gtk_window_set_default_icon"
gtk_window_set_default_icon :: ((Ptr Pixbuf) -> (IO ()))
foreign import ccall safe "gtk_window_set_default_icon_from_file"
gtk_window_set_default_icon_from_file :: ((Ptr CChar) -> ((Ptr (Ptr ())) -> (IO CInt)))
foreign import ccall safe "gtk_window_get_default_icon_name"
gtk_window_get_default_icon_name :: (IO (Ptr CChar))
foreign import ccall safe "gtk_window_set_screen"
gtk_window_set_screen :: ((Ptr Window) -> ((Ptr Screen) -> (IO ())))
foreign import ccall safe "gtk_window_get_screen"
gtk_window_get_screen :: ((Ptr Window) -> (IO (Ptr Screen)))
foreign import ccall safe "gtk_window_set_icon_from_file"
gtk_window_set_icon_from_file :: ((Ptr Window) -> ((Ptr CChar) -> ((Ptr (Ptr ())) -> (IO CInt))))
foreign import ccall safe "gtk_window_set_auto_startup_notification"
gtk_window_set_auto_startup_notification :: (CInt -> (IO ()))
foreign import ccall safe "gtk_window_set_gravity"
gtk_window_set_gravity :: ((Ptr Window) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_window_get_gravity"
gtk_window_get_gravity :: ((Ptr Window) -> (IO CInt))
foreign import ccall safe "gtk_window_move"
gtk_window_move :: ((Ptr Window) -> (CInt -> (CInt -> (IO ()))))
foreign import ccall safe "gtk_window_parse_geometry"
gtk_window_parse_geometry :: ((Ptr Window) -> ((Ptr CChar) -> (IO CInt)))
foreign import ccall safe "gtk_window_reshow_with_initial_size"
gtk_window_reshow_with_initial_size :: ((Ptr Window) -> (IO ()))
foreign import ccall safe "gtk_window_resize"
gtk_window_resize :: ((Ptr Window) -> (CInt -> (CInt -> (IO ()))))
foreign import ccall safe "gtk_window_begin_resize_drag"
gtk_window_begin_resize_drag :: ((Ptr Window) -> (CInt -> (CInt -> (CInt -> (CInt -> (CUInt -> (IO ())))))))
foreign import ccall safe "gtk_window_begin_move_drag"
gtk_window_begin_move_drag :: ((Ptr Window) -> (CInt -> (CInt -> (CInt -> (CUInt -> (IO ()))))))
foreign import ccall safe "gtk_window_get_position"
gtk_window_get_position :: ((Ptr Window) -> ((Ptr CInt) -> ((Ptr CInt) -> (IO ()))))
foreign import ccall safe "gtk_window_get_size"
gtk_window_get_size :: ((Ptr Window) -> ((Ptr CInt) -> ((Ptr CInt) -> (IO ()))))
foreign import ccall safe "gtk_window_set_type_hint"
gtk_window_set_type_hint :: ((Ptr Window) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_window_get_type_hint"
gtk_window_get_type_hint :: ((Ptr Window) -> (IO CInt))
foreign import ccall safe "gtk_window_present_with_time"
gtk_window_present_with_time :: ((Ptr Window) -> (CUInt -> (IO ())))
foreign import ccall safe "gtk_window_set_urgency_hint"
gtk_window_set_urgency_hint :: ((Ptr Window) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_window_get_urgency_hint"
gtk_window_get_urgency_hint :: ((Ptr Window) -> (IO CInt))
foreign import ccall safe "gtk_window_set_geometry_hints"
gtk_window_set_geometry_hints :: ((Ptr Window) -> ((Ptr Widget) -> ((Ptr ()) -> (CInt -> (IO ())))))
foreign import ccall safe "gtk_window_set_opacity"
gtk_window_set_opacity :: ((Ptr Window) -> (CDouble -> (IO ())))
foreign import ccall safe "gtk_window_get_opacity"
gtk_window_get_opacity :: ((Ptr Window) -> (IO CDouble))
foreign import ccall safe "gtk_window_get_group"
gtk_window_get_group :: ((Ptr Window) -> (IO (Ptr WindowGroup)))
foreign import ccall safe "gtk_window_get_window_type"
gtk_window_get_window_type :: ((Ptr Window) -> (IO CInt))
foreign import ccall unsafe "gtk_window_type_get_type"
gtk_window_type_get_type :: CUInt
foreign import ccall unsafe "gtk_window_position_get_type"
gtk_window_position_get_type :: CUInt