{-# 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,
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,
windowHasResizeGrip,
windowModal,
windowOpacity,
windowRole,
windowStartupId,
windowWindowPosition,
windowDefaultWidth,
windowDefaultHeight,
windowDeletable,
windowDestroyWithParent,
windowIcon,
windowIconName,
windowScreen,
windowTypeHint,
windowSkipTaskbarHint,
windowSkipPagerHint,
windowUrgencyHint,
windowAcceptFocus,
windowFocusOnMap,
windowDecorated,
windowGravity,
windowToplevelFocus,
windowTransientFor,
windowFocus,
windowIconList,
windowMnemonicModifier,
windowMnemonicVisible,
frameEvent,
keysChanged,
setFocus,
{-# LINE 278 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
) 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.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.
GObjectClass 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.
GObjectClass 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)
windowSetHasResizeGrip :: WindowClass self => self -> Bool -> IO ()
windowSetHasResizeGrip :: forall self. WindowClass self => self -> Bool -> IO ()
windowSetHasResizeGrip 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_resize_grip Ptr Window
argPtr1 CInt
arg2)
{-# LINE 378 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
setting)
windowGetHasResizeGrip :: WindowClass self => self -> IO Bool
windowGetHasResizeGrip :: forall self. WindowClass self => self -> IO Bool
windowGetHasResizeGrip 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_resize_grip Ptr Window
argPtr1)
{-# LINE 387 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
(toWindow self)
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)
{-# LINE 430 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
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.
GObjectClass 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.
GObjectClass 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.
GObjectClass 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)
{-# LINE 1214 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
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
{-# LINE 1398 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
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 GdkWindowHints
GdkHintBaseSize = Int
8
fromEnum GdkWindowHints
GdkHintAspect = Int
16
fromEnum GdkWindowHints
GdkHintResizeInc = Int
32
fromEnum GdkWindowHints
GdkHintWinGravity = Int
64
fromEnum GdkWindowHints
GdkHintUserPos = Int
128
fromEnum GdkWindowHints
GdkHintUserSize = Int
256
toEnum :: Int -> GdkWindowHints
toEnum Int
1 = GdkWindowHints
GdkHintPos
toEnum Int
2 = GdkWindowHints
GdkHintMinSize
toEnum Int
4 = GdkWindowHints
GdkHintMaxSize
toEnum Int
8 = GdkWindowHints
GdkHintBaseSize
toEnum Int
16 = GdkWindowHints
GdkHintAspect
toEnum Int
32 = GdkWindowHints
GdkHintResizeInc
toEnum Int
64 = GdkWindowHints
GdkHintWinGravity
toEnum Int
128 = GdkWindowHints
GdkHintUserPos
toEnum Int
256 = GdkWindowHints
GdkHintUserSize
toEnum Int
unmatched = FilePath -> GdkWindowHints
forall a. HasCallStack => FilePath -> a
error (FilePath
"GdkWindowHints.toEnum: Cannot match " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
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 1972 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
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
windowHasResizeGrip :: WindowClass self => Attr self Bool
windowHasResizeGrip :: forall self. WindowClass self => Attr self Bool
windowHasResizeGrip = (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
windowGetHasResizeGrip
self -> Bool -> IO ()
forall self. WindowClass self => self -> Bool -> IO ()
windowSetHasResizeGrip
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
{-# LINE 2104 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
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")
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_set_has_resize_grip"
gtk_window_set_has_resize_grip :: ((Ptr Window) -> (CInt -> (IO ())))
foreign import ccall unsafe "gtk_window_get_has_resize_grip"
gtk_window_get_has_resize_grip :: ((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_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_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_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_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