{-# LINE 2 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
{-# LANGUAGE OverloadedStrings #-}

{-# LINE 3 "./Graphics/UI/Gtk/Windows/Window.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Window
--
-- Author : Manuel M. T. Chakravarty, Axel Simon, Andy Stewart
--
-- Created: 27 April 2001
--
-- Copyright (C) 2001-2005 Manuel M. T. Chakravarty, Axel Simon
-- Copyright (C) 2009 Andy Stewart
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- Toplevel which can contain other widgets
--
module Graphics.UI.Gtk.Windows.Window (

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----'Widget'
-- | +----'Container'
-- | +----'Bin'
-- | +----Window
-- | +----'Dialog'
-- | +----'Plug'
-- @

-- * Types
  Window,
  WindowClass,
  castToWindow, gTypeWindow,
  toWindow,
  WindowType(..),
  WindowEdge(..),
  WindowTypeHint(..),
  Gravity(..),

-- * Constructors
  windowNew,
  windowNewPopup,

-- * Methods
  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,


-- * Attributes
  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,


-- * Signals
  frameEvent,
  keysChanged,
  setFocus,

-- * Deprecated
{-# 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" #-}

--------------------
-- Constructors

-- | Create a new top level window.
--
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)

-- | Create a popup window.
--
windowNewPopup :: IO Window
windowNewPopup :: IO Window
windowNewPopup =
  (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)

--------------------
-- Methods

-- | Sets the title of the 'Window'. The title of a window will be displayed
-- in its title bar; on the X Window System, the title bar is rendered by the
-- window manager, so exactly how the title appears to users may vary according
-- to a user's exact configuration. The title should help a user distinguish
-- this window from other windows they may have open. A good title might
-- include the application name and current document filename, for example.
--
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

-- | Retrieves the title of the window. See 'windowSetTitle'.
--
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

-- | Sets whether the user can resize a window. Windows are user resizable by
-- default.
--
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)

-- | Gets the value set by 'windowSetResizable'.
--
windowGetResizable :: WindowClass self => self
 -> IO Bool -- ^ returns @True@ if the user can resize the window
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)


-- | Sets whether the window has a resize grip. @True@ by default.
--
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)

-- | Returns whether the window has a resize grip.
--
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)


-- | Activates the current focused widget within the window.
--
windowActivateFocus :: WindowClass self => self
 -> IO Bool -- ^ returns @True@ if a widget got activated.
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)

-- | Activates the default widget for the window, unless the current focused
-- widget has been configured to receive the default action (see
-- 'ReceivesDefault' in 'WidgetFlags'), in which case the focused widget is
-- activated.
--
windowActivateDefault :: WindowClass self => self
 -> IO Bool -- ^ returns @True@ if a widget got activated.
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" #-}
-- | Sets a window modal or non-modal. Modal windows prevent interaction with
-- other windows in the same application. To keep modal dialogs on top of main
-- application windows, use 'windowSetTransientFor' to make the dialog
-- transient for the parent; most window managers will then disallow lowering
-- the dialog below the parent.
--
windowSetModal :: WindowClass self => self
 -> Bool -- ^ @modal@ - whether the window is modal
 -> 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)

-- | Returns whether the window is modal. See 'windowSetModal'.
--
windowGetModal :: WindowClass self => self
 -> IO Bool -- ^ returns @True@ if the window is set to be modal and
            -- establishes a grab when shown
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)

-- | Sets the default size of a window. If the window's \"natural\" size (its
-- size request) is larger than the default, the default will be ignored. More
-- generally, if the default size does not obey the geometry hints for the
-- window ('windowSetGeometryHints' can be used to set these explicitly), the
-- default size will be clamped to the nearest permitted size.
--
-- Unlike 'widgetSetSizeRequest', which sets a size request for a widget and
-- thus would keep users from shrinking the window, this function only sets the
-- initial size, just as if the user had resized the window themselves. Users
-- can still shrink the window again as they normally would. Setting a default
-- size of -1 means to use the \"natural\" default size (the size request of
-- the window).
--
-- For more control over a window's initial size and how resizing works,
-- investigate 'windowSetGeometryHints'.
--
-- For some uses, 'windowResize' is a more appropriate function.
-- 'windowResize' changes the current size of the window, rather than the size
-- to be used on initial display. 'windowResize' always affects the window
-- itself, not the geometry widget.
--
-- The default size of a window only affects the first time a window is
-- shown; if a window is hidden and re-shown, it will remember the size it had
-- prior to hiding, rather than using the default size.
--
-- Windows can't actually be 0x0 in size, they must be at least 1x1, but
-- passing 0 for @width@ and @height@ is OK, resulting in a 1x1 default size.
--
windowSetDefaultSize :: WindowClass self => self
 -> Int -- ^ @height@ - height in pixels, or -1 to unset the default height
 -> Int -- ^ @width@ - width in pixels, or -1 to unset the default width
 -> 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)

-- | Adds a mnemonic to this window.
--
windowAddMnemonic :: (WindowClass self, WidgetClass widget) => self
 -> KeyVal -- ^ @keyval@ - the mnemonic
 -> widget -- ^ @target@ - the widget that gets activated by the mnemonic
 -> 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)

-- | Removes a mnemonic from this window.
--
windowRemoveMnemonic :: (WindowClass self, WidgetClass widget) => self
 -> KeyVal -- ^ @keyval@ - the mnemonic
 -> widget -- ^ @target@ - the widget that gets activated by the mnemonic
 -> 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)

-- | Activates the targets associated with the mnemonic.
windowMnemonicActivate :: WindowClass self => self
 -> KeyVal -- ^ @keyval@ - the mnemonic
 -> [Modifier] -- ^ @modifier@ - the modifiers
 -> IO Bool -- ^ return @True@ if the activation is done.
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))

-- | Sets the mnemonic modifier for this window.
windowSetMnemonicModifier :: WindowClass self => self
 -> [Modifier] -- ^ @modifier@ - the modifier mask used to activate mnemonics on this window.
 -> 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))

-- | Returns the mnemonic modifier for this window. See 'windowSetMnemonicModifier'.
windowGetMnemonicModifier :: WindowClass self => self
 -> IO [Modifier] -- ^ return the modifier mask used to activate mnemonics on this window.
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)

-- | Activates mnemonics and accelerators for this 'Window'.
-- This is normally called by the default 'keyPressEvent' handler for toplevel windows,
-- however in some cases it may be useful to call this directly when overriding the standard key handling for a toplevel window.
--
windowActivateKey :: WindowClass self => self -> EventM EKey Bool
  -- ^ return @True@ if a mnemonic or accelerator was found and activated.
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)

-- | Propagate a key press or release event to the focus widget and up the focus container chain until a widget handles event.
-- This is normally called by the default 'keyPressEvent' and 'keyReleaseEvent' handlers for toplevel windows,
-- however in some cases it may be useful to call this directly when overriding the standard key handling for a toplevel window.
--
windowPropagateKeyEvent :: WindowClass self => self
  -> EventM EKey Bool
  -- ^ return @True@ if a widget in the focus chain handled the event.
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)

-- | Gets the default size of the window. A value of -1 for the width or
-- height indicates that a default size has not been explicitly set for that
-- dimension, so the \"natural\" size of the window will be used.
--
windowGetDefaultSize :: WindowClass self => self
 -> IO (Int, Int) -- ^ @(width, height)@ - the default width and height
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)

-- | Sets a position constraint for this window. If the old or new constraint
-- is 'WinPosCenterAlways', this will also cause the window to be repositioned
-- to satisfy the new constraint.
--
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)

-- | Dialog windows should be set transient for the main application window
-- they were spawned from. This allows window managers to e.g. keep the dialog
-- on top of the main window, or center the dialog over the main window.
-- 'dialogNewWithButtons' and other convenience functions in Gtk+ will
-- sometimes call 'windowSetTransientFor' on your behalf.
--
-- On Windows, this function will and put the child window on top of the
-- parent, much as the window manager would have done on X.
--
-- Note that if you want to show a window @self@ on top of a full-screen window @parent@, you need to
-- turn the @self@ window into a dialog (using 'windowSetTypeHint' with 'WindowTypeHintDialog').
-- Otherwise the @parent@ window will always cover the @self@ window.
--
windowSetTransientFor :: (WindowClass self, WindowClass parent) => self
 -> parent -- ^ @parent@ - parent window
 -> 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)

-- | Fetches the transient parent for this window. See
-- 'windowSetTransientFor'.
--
windowGetTransientFor :: WindowClass self => self
 -> IO (Maybe Window) -- ^ returns the transient parent for this window, or
                      -- @Nothing@ if no transient parent has been set.
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)

-- | If this setting is @True@, then destroying the transient parent of the
-- window will also destroy the window itself. This is useful for dialogs that
-- shouldn't persist beyond the lifetime of the main window they\'re associated
-- with, for example.
--
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)

-- | Returns whether the window will be destroyed with its transient parent.
-- See 'windowSetDestroyWithParent'.
--
windowGetDestroyWithParent :: WindowClass self => self
 -> IO Bool -- ^ returns @True@ if the window will be destroyed with its
            -- transient parent.
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)


-- | Returns whether the window is part of the current active toplevel. (That
-- is, the toplevel window receiving keystrokes.) The return value is @True@ if
-- the window is active toplevel itself, but also if it is, say, a 'Plug'
-- embedded in the active toplevel. You might use this function if you wanted
-- to draw a widget differently in an active window from a widget in an
-- inactive window. See 'windowHasToplevelFocus'
--
-- * Available since Gtk+ version 2.4
--
windowIsActive :: WindowClass self => self
 -> IO Bool -- ^ returns @True@ if the window part of the current active
            -- window.
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)

-- | Returns whether the input focus is within this 'Window'. For real
-- toplevel windows, this is identical to 'windowIsActive', but for embedded
-- windows, like 'Plug', the results will differ.
--
-- * Available since Gtk+ version 2.4
--
windowHasToplevelFocus :: WindowClass self => self
 -> IO Bool -- ^ returns @True@ if the the input focus is within this 'Window'
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)


-- | Returns a list of all existing toplevel windows.
--
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

-- | Retrieves the current focused widget within the window.
-- | Note that this is the widget that would have the focus if the toplevel
-- | window focused; if the toplevel window is not focused then
-- | 'widgetHasFocus' will not be True for the widget.
--
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)

-- | If focus is not the current focus widget, and is focusable, sets it as
-- | the focus widget for the window. If focus is Nothing, unsets the focus
-- | widget for this window. To set the focus to a particular widget in the
-- | toplevel, it is usually more convenient to use 'widgetGrabFocus' instead
-- | of this function.
--
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)


-- | Returns the default widget for window. See 'windowSetDefault' for more details.
--
-- * Available since Gtk+ version 2.14
--
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)


-- | The default widget is the widget that's activated when the user presses
-- Enter in a dialog (for example). This function sets or unsets the default
-- widget for a Window about. When setting (rather than unsetting) the
-- default widget it's generally easier to call widgetGrabDefault on the
-- widget. Before making a widget the default widget, you must set the
-- 'widgetCanDefault' flag on the widget.
--
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)

-- | Presents a window to the user. This may mean raising the window in the
-- stacking order, deiconifying it, moving it to the current desktop, and\/or
-- giving it the keyboard focus, possibly dependent on the user's platform,
-- window manager, and preferences.
--
-- If @window@ is hidden, this function calls 'widgetShow' as well.
--
-- This function should be used when the user tries to open a window that's
-- already open. Say for example the preferences dialog is currently open, and
-- the user chooses Preferences from the menu a second time; use
-- 'windowPresent' to move the already-open dialog where the user can see it.
--
-- If you are calling this function in response to a user interaction, it is
-- preferable to use 'windowPresentWithTime'.
--
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)

-- | Asks to deiconify (i.e. unminimize) the specified @window@. Note that you
-- shouldn't assume the window is definitely deiconified afterward, because
-- other entities (e.g. the user or window manager) could iconify it again
-- before your code which assumes deiconification gets to run.
--
-- You can track iconification via the 'windowStateEvent' signal on
-- 'Widget'.
--
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)

-- | Asks to iconify (i.e. minimize) the specified @window@. Note that you
-- shouldn't assume the window is definitely iconified afterward, because other
-- entities (e.g. the user or window manager) could deiconify it again, or
-- there may not be a window manager in which case iconification isn't
-- possible, etc. But normally the window will end up iconified. Just don't
-- write code that crashes if not.
--
-- It's permitted to call this function before showing a window, in which
-- case the window will be iconified before it ever appears onscreen.
--
-- You can track iconification via the 'windowStateEvent' signal on
-- 'Widget'.
--
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)

-- | Asks to maximize the window, so that it becomes full-screen. Note that you
-- shouldn't assume the window is definitely maximized afterward, because other
-- entities (e.g. the user or window manager) could unmaximize it again, and
-- not all window managers support maximization. But normally the window will
-- end up maximized. Just don't write code that crashes if not.
--
-- It's permitted to call this function before showing a window, in which
-- case the window will be maximized when it appears onscreen initially.
--
-- You can track maximization via the 'windowStateEvent' signal on
-- 'Widget'.
--
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)

-- | Asks to unmaximize the window. Note that you shouldn't assume the window is
-- definitely unmaximized afterward, because other entities (e.g. the user or
-- window manager) could maximize it again, and not all window managers honor
-- requests to unmaximize. But normally the window will end up unmaximized.
-- Just don't write code that crashes if not.
--
-- You can track maximization via the 'windowStateEvent' signal on
-- 'Widget'.
--
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)


-- | Asks to place @window@ in the fullscreen state. Note that you shouldn't
-- assume the window is definitely full screen afterward, because other
-- entities (e.g. the user or window manager) could unfullscreen it again, and
-- not all window managers honor requests to fullscreen windows. But normally
-- the window will end up fullscreen. Just don't write code that crashes if
-- not.
--
-- You can track the fullscreen state via the 'windowStateEvent' signal
-- on 'Widget'.
--
-- * Available since Gtk+ version 2.2
--
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)

-- | Asks to toggle off the fullscreen state for @window@. Note that you
-- shouldn't assume the window is definitely not full screen afterward, because
-- other entities (e.g. the user or window manager) could fullscreen it again,
-- and not all window managers honor requests to unfullscreen windows. But
-- normally the window will end up restored to its normal state. Just don't
-- write code that crashes if not.
--
-- You can track the fullscreen state via the 'windowStateEvent' signal
-- on 'Widget'.
--
-- * Available since Gtk+ version 2.2
--
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)


-- | Asks to keep @window@ above, so that it stays on top. Note that you
-- shouldn't assume the window is definitely above afterward, because other
-- entities (e.g. the user or window manager) could not keep it above, and not
-- all window managers support keeping windows above. But normally the window
-- will end kept above. Just don't write code that crashes if not.
--
-- It's permitted to call this function before showing a window, in which
-- case the window will be kept above when it appears onscreen initially.
--
-- You can track the above state via the 'windowStateEvent' signal on
-- 'Widget'.
--
-- Note that, according to the Extended Window Manager Hints specification,
-- the above state is mainly meant for user preferences and should not be used
-- by applications e.g. for drawing attention to their dialogs.
--
-- * Available since Gtk+ version 2.4
--
windowSetKeepAbove :: WindowClass self => self
 -> Bool -- ^ @setting@ - whether to keep @window@ above other windows
 -> 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)

-- | Asks to keep @window@ below, so that it stays in bottom. Note that you
-- shouldn't assume the window is definitely below afterward, because other
-- entities (e.g. the user or window manager) could not keep it below, and not
-- all window managers support putting windows below. But normally the window
-- will be kept below. Just don't write code that crashes if not.
--
-- It's permitted to call this function before showing a window, in which
-- case the window will be kept below when it appears onscreen initially.
--
-- You can track the below state via the 'windowStateEvent' signal on
-- 'Widget'.
--
-- Note that, according to the Extended Window Manager Hints specification,
-- the above state is mainly meant for user preferences and should not be used
-- by applications e.g. for drawing attention to their dialogs.
--
-- * Available since Gtk+ version 2.4
--
windowSetKeepBelow :: WindowClass self => self
 -> Bool -- ^ @setting@ - whether to keep @window@ below other windows
 -> 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)


-- | Windows may set a hint asking the desktop environment not to display the
-- window in the task bar. This function sets this hint.
--
-- * Available since Gtk+ version 2.2
--
windowSetSkipTaskbarHint :: WindowClass self => self
 -> Bool -- ^ @setting@ - @True@ to keep this window from appearing in the
          -- task bar
 -> 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)

-- | Gets the value set by 'windowSetSkipTaskbarHint'
--
-- * Available since Gtk+ version 2.2
--
windowGetSkipTaskbarHint :: WindowClass self => self
 -> IO Bool -- ^ returns @True@ if window shouldn't be in taskbar
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)

-- | Windows may set a hint asking the desktop environment not to display the
-- window in the pager. This function sets this hint. (A \"pager\" is any
-- desktop navigation tool such as a workspace switcher that displays a
-- thumbnail representation of the windows on the screen.)
--
-- * Available since Gtk+ version 2.2
--
windowSetSkipPagerHint :: WindowClass self => self
 -> Bool -- ^ @setting@ - @True@ to keep this window from appearing in the
          -- pager
 -> IO ()
windowSetSkipPagerHint :: forall self. WindowClass self => self -> Bool -> IO ()
windowSetSkipPagerHint 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)

-- | Gets the value set by 'windowSetSkipPagerHint'.
--
-- * Available since Gtk+ version 2.2
--
windowGetSkipPagerHint :: WindowClass self => self
 -> IO Bool -- ^ returns @True@ if window shouldn't be in pager
windowGetSkipPagerHint :: forall self. WindowClass self => self -> IO Bool
windowGetSkipPagerHint 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)



-- | Windows may set a hint asking the desktop environment not to receive the
-- input focus. This function sets this hint.
--
-- * Available since Gtk+ version 2.4
--
windowSetAcceptFocus :: WindowClass self => self
 -> Bool -- ^ @setting@ - @True@ to let this window receive input focus
 -> 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)

-- | Gets the value set by 'windowSetAcceptFocus'.
--
-- * Available since Gtk+ version 2.4
--
windowGetAcceptFocus :: WindowClass self => self
 -> IO Bool -- ^ returns @True@ if window should receive the input focus
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)



-- | Windows may set a hint asking the desktop environment not to receive the
-- input focus when the window is mapped. This function sets this hint.
--
-- * Available since Gtk+ version 2.6
--
windowSetFocusOnMap :: WindowClass self => self
 -> Bool -- ^ @setting@ - @True@ to let this window receive input focus on
          -- map
 -> 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)

-- | Gets the value set by 'windowSetFocusOnMap'.
--
-- * Available since Gtk+ version 2.6
--
windowGetFocusOnMap :: WindowClass self => self
 -> IO Bool -- ^ returns @True@ if window should receive the input focus when
            -- mapped.
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)



-- | Startup notification identifiers are used by desktop environment to track application startup,
-- to provide user feedback and other features. This function changes the corresponding property on the underlying GdkWindow.
-- Normally, startup identifier is managed automatically and you should only use this function in special cases like transferring focus from other processes. You should use this function before calling 'windowPresent' or any equivalent function generating a window map event.
--
-- This function is only useful on X11, not with other GTK+ targets.
--
-- * Available since Gtk+ version 2.12
--
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


-- | By default, windows are decorated with a title bar, resize controls, etc.
-- Some window managers allow Gtk+ to disable these decorations, creating a
-- borderless window. If you set the decorated property to @False@ using this
-- function, Gtk+ will do its best to convince the window manager not to
-- decorate the window. Depending on the system, this function may not have any
-- effect when called on a window that is already visible, so you should call
-- it before calling 'windowShow'.
--
-- On Windows, this function always works, since there's no window manager
-- policy involved.
--
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)

-- | Returns whether the window has been set to have decorations such as a
-- title bar via 'windowSetDecorated'.
--
windowGetDecorated :: WindowClass self => self
 -> IO Bool -- ^ returns @True@ if the window has been set to have decorations
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" #-}
-- | Asks to stick @window@, which means that it will appear on all user
-- desktops. Note that you shouldn't assume the window is definitely stuck
-- afterward, because other entities (e.g. the user or window manager) could
-- unstick it again, and some window managers do not support sticking windows.
-- But normally the window will end up stuck. Just don't write code that
-- crashes if not.
--
-- It's permitted to call this function before showing a window.
--
-- You can track stickiness via the 'windowStateEvent' signal on
-- 'Widget'.
--
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)

-- | Asks to unstick @window@, which means that it will appear on only one of
-- the user's desktops. Note that you shouldn't assume the window is definitely
-- unstuck afterward, because other entities (e.g. the user or window manager)
-- could stick it again. But normally the window will end up stuck. Just don't
-- write code that crashes if not.
--
-- You can track stickiness via the 'windowStateEvent' signal on
-- 'Widget'.
--
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)

-- | Associate @accelGroup@ with @window@, such that calling
-- 'accelGroupsActivate' on @window@ will activate accelerators in
-- @accelGroup@.
--
windowAddAccelGroup :: WindowClass self => self
 -> AccelGroup -- ^ @accelGroup@ - a '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

-- | Reverses the effects of 'windowAddAccelGroup'.
--
windowRemoveAccelGroup :: WindowClass self => self
 -> AccelGroup -- ^ @accelGroup@ - a '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

-- | Sets up the icon representing a 'Window'. This icon is used when the
-- window is minimized (also known as iconified). Some window managers or
-- desktop environments may also place it in the window frame, or display it in
-- other contexts.
--
-- The icon should be provided in whatever size it was naturally drawn; that
-- is, don't scale the image before passing it to Gtk+. Scaling is postponed
-- until the last minute, when the desired final size is known, to allow best
-- quality.
--
-- If you have your icon hand-drawn in multiple sizes, use
-- 'windowSetIconList'. Then the best size will be used.
--
-- This function is equivalent to calling 'windowSetIconList' with a
-- 1-element list.
--
-- See also 'windowSetDefaultIconList' to set the icon for all windows in
-- your application in one go.
--
windowSetIcon :: WindowClass self => self
 -> Maybe Pixbuf -- ^ @icon@ - icon image
 -> 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

-- | Gets the value set by 'windowSetIcon' (or if you\'ve called
-- 'windowSetIconList', gets the first icon in the icon list).
--
windowGetIcon :: WindowClass self => self
 -> IO (Maybe Pixbuf) -- ^ returns icon for window, or @Nothing@ if none was set
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)

-- | Sets up the icon representing a 'Window'. The icon is used when the window is minimized (also known as iconified).
-- Some window managers or desktop environments may also place it in the window frame, or display it in other contexts.
--
-- 'windowSetIconList' allows you to pass in the same icon in several hand-drawn sizes.
-- The list should contain the natural sizes your icon is available in; that is, don't scale the image before passing it to GTK+.
-- Scaling is postponed until the last minute, when the desired final size is known, to allow best quality.
--
-- By passing several sizes, you may improve the final image quality of the icon, by reducing or eliminating automatic image scaling.
--
-- Recommended sizes to provide: 16x16, 32x32, 48x48 at minimum, and larger images (64x64, 128x128) if you have them.
--
-- See also 'windowSetDefaultIconList' to set the icon for all windows in your application in one go.
--
-- Note that transient windows (those who have been set transient for another window using 'windowSetTransientFor' will inherit their icon from their
-- transient parent.
-- So there's no need to explicitly set the icon on transient windows.
--
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

-- | Retrieves the list of icons set by 'windowSetIconList'.
--
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

-- | Sets an icon list to be used as fallback for windows that haven't had 'windowSetIconList' called on them to set up a window-specific icon list.
-- This function allows you to set up the icon for all windows in your app at once.
--
-- See 'windowSetIconList' for more details.
--
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

-- | Gets the value set by 'windowSetDefaultIconList'.
--
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" #-}
-- | Sets an icon to be used as fallback for windows that haven't had
-- 'windowSetIconList' called on them from a named themed icon, see
-- 'windowSetIconName'.
--
-- * Available since Gtk+ version 2.6
--
windowSetDefaultIconName :: GlibString string
 => string -- ^ @name@ - the name of the themed icon
 -> 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



-- | Sets an icon to be used as fallback for windows that haven't had 'windowSetIcon' called on them from a pixbuf.
--
-- * Available since Gtk+ version 2.4
--
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)



-- | Sets an icon to be used as fallback for windows that haven't had
-- 'windowSetIconList' called on them from a file on disk. May throw a 'GError' if
-- the file cannot be loaded.
--
-- * Available since Gtk+ version 2.2
--
windowSetDefaultIconFromFile :: GlibString string
 => string -- ^ @filename@ - location of icon file
 -> IO Bool -- ^ returns @True@ if setting the icon succeeded.
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



-- | Returns the fallback icon name for windows that has been set with
-- 'windowSetDefaultIconName'.
--
-- * Available since Gtk+ version 2.16
--
windowGetDefaultIconName :: GlibString string
 => IO string -- ^ returns the fallback icon name for windows
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



-- | Sets the 'Screen' where the @window@ is displayed; if the window is
-- already mapped, it will be unmapped, and then remapped on the new screen.
--
-- * Available since Gtk+ version 2.2
--
windowSetScreen :: WindowClass self => self
 -> Screen -- ^ @screen@ - a '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

-- | Returns the 'Screen' associated with the window.
--
-- * Available since Gtk+ version 2.2
--
windowGetScreen :: WindowClass self => self
 -> IO Screen -- ^ returns a '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)

-- | Sets the icon for @window@.
--
-- This function is equivalent to calling 'windowSetIcon' with a pixbuf
-- created by loading the image from @filename@.
--
-- This may throw an exception if the file cannot be loaded.
--
-- * Available since Gtk+ version 2.2
--
windowSetIconFromFile :: (WindowClass self, GlibFilePath fp) => self
 -> fp -- ^ @filename@ - location of icon file
 -> 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 ()

-- | By default, after showing the first 'Window' for each 'Screen', Gtk+
-- calls 'screenNotifyStartupComplete'. Call this function to disable the
-- automatic startup notification. You might do this if your first window is a
-- splash screen, and you want to delay notification until after your real main
-- window has been shown, for example.
--
-- In that example, you would disable startup notification temporarily, show
-- your splash screen, then re-enable it so that showing the main window would
-- automatically result in notification.
--
-- * Available since Gtk+ version 2.2
--
windowSetAutoStartupNotification ::
    Bool -- ^ @setting@ - @True@ to automatically do startup notification
 -> 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)


-- | Window gravity defines the meaning of coordinates passed to 'windowMove'.
-- See 'windowMove' and 'Gravity' for more details.
--
-- The default window gravity is 'GravityNorthWest' which will typically
-- \"do what you mean.\"
--
windowSetGravity :: WindowClass self => self
 -> Gravity -- ^ @gravity@ - window 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)

-- | Gets the value set by 'windowSetGravity'.
--
windowGetGravity :: WindowClass self => self
 -> IO Gravity -- ^ returns window 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)

-- | Asks the window manager to move @window@ to the given position. Window
-- managers are free to ignore this; most window managers ignore requests for
-- initial window positions (instead using a user-defined placement algorithm)
-- and honor requests after the window has already been shown.
--
-- Note: the position is the position of the gravity-determined reference
-- point for the window. The gravity determines two things: first, the location
-- of the reference point in root window coordinates; and second, which point
-- on the window is positioned at the reference point.
--
-- By default the gravity is 'GravityNorthWest', so the reference point is
-- simply the @x@, @y@ supplied to 'windowMove'. The top-left corner of the
-- window decorations (aka window frame or border) will be placed at @x@, @y@.
-- Therefore, to position a window at the top left of the screen, you want to
-- use the default gravity (which is 'GravityNorthWest') and move the window to
-- 0,0.
--
-- To position a window at the bottom right corner of the screen, you would
-- set 'GravitySouthEast', which means that the reference point is at @x@ + the
-- window width and @y@ + the window height, and the bottom-right corner of the
-- window border will be placed at that reference point. So, to place a window
-- in the bottom right corner you would first set gravity to south east, then
-- write: @gtk_window_move (window, gdk_screen_width() - window_width,
-- gdk_screen_height() - window_height)@.
--
-- The Extended Window Manager Hints specification at
-- http:\/\/www.freedesktop.org\/Standards\/wm-spec has a nice table of
-- gravities in the \"implementation notes\" section.
--
-- The 'windowGetPosition' documentation may also be relevant.
--
windowMove :: WindowClass self => self
 -> Int -- ^ @x@ - X coordinate to move window to
 -> Int -- ^ @y@ - Y coordinate to move window to
 -> 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)

-- | Parses a standard X Window System geometry string - see the manual page for X (type 'man X') for details on this.
-- 'windowParseGeometry' does work on all GTK+ ports including Win32 but is primarily intended for an X environment.
--
-- If either a size or a position can be extracted from the geometry string,
-- 'windowParseGeometry' returns @True@ and calls gtk_window_set_default_size() and/or gtk_window_move() to resize/move the window.
--
-- If 'windowParseGeometry' returns @True@,
-- it will also set the 'HintUserPos' and/or 'HintUserSize' hints indicating to the window manager that the size/position of the window was user-specified
-- This causes most window managers to honor the geometry.
--
-- Note that for 'windowParseGeometry' to work as expected, it has to be called when the window has its "final" size, i.e.
-- after calling 'widgetShowAll' on the contents and 'windowSetGeometryHints' on the window.
--
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

-- | Hides window, then reshows it, resetting the default size and position of the window. Used by GUI builders only.
--
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)

-- | Resizes the window as if the user had done so, obeying geometry
-- constraints. The default geometry constraint is that windows may not be
-- smaller than their size request; to override this constraint, call
-- 'widgetSetSizeRequest' to set the window's request to a smaller value.
--
-- If 'windowResize' is called before showing a window for the first time,
-- it overrides any default size set with 'windowSetDefaultSize'.
--
-- Windows may not be resized smaller than 1 by 1 pixels.
--
windowResize :: WindowClass self => self
 -> Int -- ^ @width@ - width in pixels to resize the window to
 -> Int -- ^ @height@ - height in pixels to resize the window to
 -> 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)

-- | Starts resizing a window. This function is used if an application has
-- window resizing controls. When GDK can support it, the resize will be done
-- using the standard mechanism for the window manager or windowing system.
-- Otherwise, GDK will try to emulate window resizing, potentially not all that
-- well, depending on the windowing system.
--
windowBeginResizeDrag :: WindowClass self => self
 -> WindowEdge -- ^ @edge@ - position of the resize control
 -> MouseButton -- ^ @button@ - mouse button that initiated the drag
 -> Int -- ^ @rootX@ - X position where the user clicked to initiate
               -- the drag, in root window coordinates
 -> Int -- ^ @rootY@ - Y position where the user clicked to initiate
               -- the drag
 -> TimeStamp -- ^ @timestamp@ - timestamp from the click event that
               -- initiated the drag
 -> 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)

-- | Starts moving a window. This function is used if an application has
-- window movement grips. When GDK can support it, the window movement will be
-- done using the standard mechanism for the window manager or windowing
-- system. Otherwise, GDK will try to emulate window movement, potentially not
-- all that well, depending on the windowing system.
--
windowBeginMoveDrag :: WindowClass self => self
 -> MouseButton -- ^ @button@ - mouse button that initiated the drag
 -> Int -- ^ @rootX@ - X position where the user clicked to initiate the
           -- drag, in root window coordinates
 -> Int -- ^ @rootY@ - Y position where the user clicked to initiate the
           -- drag
 -> TimeStamp -- ^ @timestamp@ - timestamp from the click event that initiated
           -- the drag
 -> 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)

-- | This function returns the position you need to pass to 'windowMove' to
-- keep @window@ in its current position. This means that the meaning of the
-- returned value varies with window gravity. See 'windowMove' for more
-- details.
--
-- If you haven't changed the window gravity, its gravity will be
-- 'GravityNorthWest'. This means that 'windowGetPosition' gets the position of
-- the top-left corner of the window manager frame for the window. 'windowMove'
-- sets the position of this same top-left corner.
--
-- Moreover, nearly all window managers are historically broken with respect
-- to their handling of window gravity. So moving a window to its current
-- position as returned by 'windowGetPosition' tends to result in moving the
-- window slightly. Window managers are slowly getting better over time.
--
-- If a window has gravity 'GravityStatic' the window manager frame is not
-- relevant, and thus 'windowGetPosition' will always produce accurate results.
-- However you can't use static gravity to do things like place a window in a
-- corner of the screen, because static gravity ignores the window manager
-- decorations.
--
-- If you are saving and restoring your application's window positions, you
-- should know that it's impossible for applications to do this without getting
-- it somewhat wrong because applications do not have sufficient knowledge of
-- window manager state. The Correct Mechanism is to support the session
-- management protocol (see the \"GnomeClient\" object in the GNOME libraries
-- for example) and allow the window manager to save your window sizes and
-- positions.
--
windowGetPosition :: WindowClass self => self
 -> IO (Int, Int) -- ^ @(rootX, rootY)@ - X and Y coordinate of
                  -- gravity-determined reference point
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)

-- | Obtains the current size of the window. If the window is not onscreen, it
-- returns the size Gtk+ will suggest to the window manager for the initial
-- window size (but this is not reliably the same as the size the window
-- manager will actually select). The size obtained by 'windowGetSize' is the
-- last size received in a 'EventConfigure', that is,
-- Gtk+ uses its locally-stored size, rather than querying the X server for the
-- size. As a result, if you call 'windowResize' then immediately call
-- 'windowGetSize', the size won't have taken effect yet. After the window
-- manager processes the resize request, Gtk+ receives notification that the
-- size has changed via a configure event, and the size of the window gets
-- updated.
--
-- Note 1: Nearly any use of this function creates a race condition, because
-- the size of the window may change between the time that you get the size and
-- the time that you perform some action assuming that size is the current
-- size. To avoid race conditions, connect to \"configure_event\" on the window
-- and adjust your size-dependent state to match the size delivered in the
-- 'EventConfigure'.
--
-- Note 2: The returned size does /not/ include the size of the window
-- manager decorations (aka the window frame or border). Those are not drawn by
-- Gtk+ and Gtk+ has no reliable method of determining their size.
--
-- Note 3: If you are getting a window size in order to position the window
-- onscreen, there may be a better way. The preferred way is to simply set the
-- window's semantic type with 'windowSetTypeHint', which allows the window
-- manager to e.g. center dialogs. Also, if you set the transient parent of
-- dialogs with 'windowSetTransientFor' window managers will often center the
-- dialog over its parent window. It's much preferred to let the window manager
-- handle these things rather than doing it yourself, because all apps will
-- behave consistently and according to user prefs if the window manager
-- handles it. Also, the window manager can take the size of the window
-- decorations\/border into account, while your application cannot.
--
-- In any case, if you insist on application-specified window positioning,
-- there's /still/ a better way than doing it yourself - 'windowSetPosition'
-- will frequently handle the details for you.
--
windowGetSize :: WindowClass self => self
 -> IO (Int, Int) -- ^ @(width, height)@
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)

-- | By setting the type hint for the window, you allow the window manager to
-- decorate and handle the window in a way which is suitable to the function of
-- the window in your application.
--
-- This function should be called before the window becomes visible.
--
windowSetTypeHint :: WindowClass self => self
 -> WindowTypeHint -- ^ @hint@ - the window type
 -> 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)

-- | Gets the type hint for this window. See 'windowSetTypeHint'.
--
windowGetTypeHint :: WindowClass self => self
 -> IO WindowTypeHint -- ^ returns the type hint for @window@.
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)


-- | Presents a window to the user in response to a user interaction. If you
-- need to present a window without a timestamp, use 'windowPresent'. See
-- 'windowPresent' for details.
--
-- * Available since Gtk+ version 2.8
--
windowPresentWithTime :: WindowClass self => self
 -> TimeStamp -- ^ @timestamp@ - the timestamp of the user interaction
              -- (typically a button or key press event) which triggered this
              -- call
 -> 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)

-- | Windows may set a hint asking the desktop environment to draw the users
-- attention to the window. This function sets this hint.
--
-- * Available since Gtk+ version 2.8
--
windowSetUrgencyHint :: WindowClass self => self
 -> Bool -- ^ @setting@ - @True@ to mark this window as urgent
 -> 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)

-- | Gets the value set by 'windowSetUrgencyHint'
--
-- * Available since Gtk+ version 2.8
--
windowGetUrgencyHint :: WindowClass self => self
 -> IO Bool -- ^ returns @True@ if window is urgent
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)


-- | This function sets up hints about how a window can be resized by the
-- user. You can set a minimum and maximum size, the allowed resize increments
-- (e.g. for xterm, you can only resize by the size of a character) and aspect
-- ratios.
--
-- If you set a geometry widget, the hints will apply to the geometry widget
-- instead of directly to the toplevel window. Of course since the geometry
-- widget is a child widget of the top level window, constraining the sizing
-- behaviour of the widget will have a knock-on effect on the sizing of the
-- toplevel window.
--
-- The @minWidth@\/@minHeight@\/@maxWidth@\/@maxHeight@ fields may be set to
-- @-1@, to use the size request of the window or geometry widget. If the
-- minimum size hint is not provided, Gtk+ will use the size requisition of the
-- window (or the geometry widget if it set) as the minimum size. The base size
-- is treated similarly.
--
-- The canonical use-case for 'windowSetGeometryHints' is to get a terminal
-- widget to resize properly. Here, the terminal text area should be the
-- geometry widget. Gtk+ will then automatically set the base size of the
-- terminal window to the size of other widgets in the terminal window, such as
-- the menubar and scrollbar. Then, the @widthInc@ and @heightInc@ values
-- should be set to the size of one character in the terminal. Finally, the
-- base size should be set to the size of one character. The net effect is that
-- the minimum size of the terminal will have a 1x1 character terminal area,
-- and only terminal sizes on the \"character grid\" will be allowed.
--
-- The other useful settings are @minAspect@ and @maxAspect@. These specify a
-- width\/height ratio as a floating point number. If a geometry widget is set,
-- the aspect applies to the geometry widget rather than the entire window. The
-- most common use of these hints is probably to set @minAspect@ and
-- @maxAspect@ to the same value, thus forcing the window to keep a constant
-- aspect ratio.
--
windowSetGeometryHints :: (WindowClass self, WidgetClass widget) =>
    self -- ^ @window@ - the top level window
 -> Maybe widget -- ^ @geometryWidget@ - optionall a widget the geometry
                     -- hints will be applied to rather than directly to the
                     -- top level window
 -> Maybe (Int, Int) -- ^ @(minWidth, minHeight)@ - minimum width and height
                     -- of window (or -1 to use requisition)
 -> Maybe (Int, Int) -- ^ @(maxWidth, maxHeight)@ - maximum width and height
                     -- of window (or -1 to use requisition)
 -> Maybe (Int, Int) -- ^ @(baseWidth, baseHeight)@ - the allowed window widths
                     -- are @base_width + width_inc * N@ for any int @N@.
                     -- Similarly, the allowed window widths are @base_height +
                     -- height_inc * N@ for any int @N@. For either the base
                     -- width or height -1 is allowed as described above.
 -> Maybe (Int, Int) -- ^ @(widthInc, heightInc)@ - width and height resize
                     -- increment
 -> Maybe (Double, Double) -- ^ @(minAspect, maxAspect)@ - minimum and maximum
                           -- width\/height ratio
 -> 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
56 ((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" #-}
-- | Returns the group for window or the default group, if window is @Nothing@ or if window does not have an explicit window group.
--
-- * Available since Gtk+ version 2.10
--
windowGetGroup :: WindowClass self => Maybe self
 -> IO WindowGroup -- ^ return the 'WindowGroup' for a window or the default group
windowGetGroup self =
  makeNewGObject mkWindowGroup $
  (\(Window arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_window_get_group argPtr1) (maybe (Window nullForeignPtr) toWindow self)



-- | Gets the type of the window. See 'WindowType'.
--
-- * Available since Gtk version 2.20
--
windowGetWindowType :: WindowClass self => self
                    -> IO WindowType -- ^ returns the type of the window
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)


--------------------
-- Attributes

-- | The title of the window.
--
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

-- | The type of the window.
--
-- Default value: 'WindowToplevel'
--
windowType :: WindowClass self => ReadAttr self WindowType
windowType :: forall self. WindowClass self => ReadAttr self WindowType
windowType = FilePath -> GType -> ReadAttr self WindowType
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
FilePath -> GType -> ReadAttr gobj enum
readAttrFromEnumProperty FilePath
"type"
  GType
gtk_window_type_get_type
{-# LINE 2013 "./Graphics/UI/Gtk/Windows/Window.chs" #-}

-- | If @True@, the window has no mimimum size. Setting this to @True@ is 99%
-- of the time a bad idea.
--
-- Default value: @False@
--
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"

-- | If @True@, users can expand the window beyond its minimum size.
--
-- Default value: @True@
--
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"

-- | If @True@, users can resize the window.
--
-- Default value: @True@
--
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


-- | If @True@, window has a resize grip.
--
-- Default value: @True@
--
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


-- | If @True@, the window is modal (other windows are not usable while this
-- one is up).
--
-- Default value: @False@
--
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


-- | The requested opacity of the window. See 'windowSetOpacity' for more details about window opacity.
--
-- Allowed values: [0,1]
--
-- Default values: 1
--
-- * Available since Gtk+ version 2.12
--
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"


-- | If @focus@ is not the current focus widget, and is focusable, sets it as
-- the focus widget for the window. If @focus@ is @Nothing@, unsets the focus widget for
-- this window. To set the focus to a particular widget in the toplevel, it is
-- usually more convenient to use 'widgetGrabFocus' instead of this function.
--
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" #-}
-- | Sets up the icon representing a 'Window'. The icon is used when the
-- window is minimized (also known as iconified). Some window managers or
-- desktop environments may also place it in the window frame, or display it in
-- other contexts.
--
-- By passing several sizes, you may improve the final image quality of the
-- icon, by reducing or eliminating automatic image scaling.
--
-- Recommended sizes to provide: 16x16, 32x32, 48x48 at minimum, and larger
-- images (64x64, 128x128) if you have them.
--
-- See also 'windowSetDefaultIconList' to set the icon for all windows in
-- your application in one go.
--
-- Note that transient windows (those who have been set transient for
-- another window using 'windowSetTransientFor') will inherit their icon from
-- their transient parent. So there's no need to explicitly set the icon on
-- transient windows.
--
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

-- | The mnemonic modifier for this window.
--
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"


-- | Unique identifier for the window to be used when restoring a session.
--
-- Default value: "\\"
--
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"


-- | The 'windowStartupId' is a write-only property for setting window's startup notification identifier.
--
-- Default value: "\\"
--
-- * Available since Gtk+ version 2.12
--
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"


-- | The initial position of the window.
--
-- Default value: 'WinPosNone'
--
windowWindowPosition :: WindowClass self => Attr self WindowPosition
windowWindowPosition :: forall self. WindowClass self => Attr self WindowPosition
windowWindowPosition = FilePath -> GType -> Attr self WindowPosition
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
FilePath -> GType -> Attr gobj enum
newAttrFromEnumProperty FilePath
"window-position"
  GType
gtk_window_position_get_type
{-# LINE 2165 "./Graphics/UI/Gtk/Windows/Window.chs" #-}

-- | The default width of the window, used when initially showing the window.
--
-- Allowed values: >= -1
--
-- Default value: -1
--
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"

-- | The default height of the window, used when initially showing the window.
--
-- Allowed values: >= -1
--
-- Default value: -1
--
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"

-- | Whether the window frame should have a close button.
--
-- Default values: @True@
--
-- * Available since Gtk+ version 2.10
--
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"

-- | If this window should be destroyed when the parent is destroyed.
--
-- Default value: @False@
--
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

-- | Icon for this window.
--
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

-- | The 'windowIconName' property specifies the name of the themed icon to use as the window icon. See 'IconTheme' for more details.
--
-- Default values: "\\"
--
-- * Available since Gtk+ version 2.6
--
--
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"


-- | The screen where this window will be displayed.
--
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


-- | Hint to help the desktop environment understand what kind of window this
-- is and how to treat it.
--
-- Default value: 'WindowTypeHintNormal'
--
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


-- | @True@ if the window should not be in the task bar.
--
-- Default value: @False@
--
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

-- | @True@ if the window should not be in the pager.
--
-- Default value: @False@
--
windowSkipPagerHint :: WindowClass self => Attr self Bool
windowSkipPagerHint :: forall self. WindowClass self => Attr self Bool
windowSkipPagerHint = (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



-- | @True@ if the window should be brought to the user's attention.
--
-- Default value: @False@
--
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



-- | @True@ if the window should receive the input focus.
--
-- Default value: @True@
--
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



-- | @True@ if the window should receive the input focus when mapped.
--
-- Default value: @True@
--
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



-- | Whether the window should be decorated by the window manager.
--
-- Default value: @True@
--
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

-- | The window gravity of the window. See 'windowMove' and 'Gravity' for more
-- details about window gravity.
--
-- Default value: 'GravityNorthWest'
--
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


-- | Whether the input focus is within this GtkWindow.
--
-- Note: If add `window` before `HasToplevelFocus` (has-toplevel-focus attribute)
-- will conflicts with fucntion `windowHasToplevelFocus`, so we named this attribute
-- to `windowToplevelFocus`.
--
-- Default values: @False@
--
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"

-- | \'transientFor\' property. See 'windowGetTransientFor' and
-- 'windowSetTransientFor'
--
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

--------------------
-- Signals

-- | Observe events that are emitted on the frame of this window.
--
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))

-- | The 'keysChanged' signal gets emitted when the set of accelerators or mnemonics that are associated with window changes.
--
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")

-- | Observe a change in input focus.
--
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")

-- * Deprecated

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"
  gtk_window_set_skip_pager_hint :: ((Ptr Window) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_window_get_skip_pager_hint"
  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 :: CULong

foreign import ccall unsafe "gtk_window_position_get_type"
  gtk_window_position_get_type :: CULong