{-# LINE 2 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget ScrolledWindow
--
-- Author : Axel Simon
--
-- Created: 23 May 2001
--
-- Copyright (C) 1999-2005 Axel Simon
--
-- 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)
--
-- Adds scrollbars to its child widget
--
module Graphics.UI.Gtk.Scrolling.ScrolledWindow (
-- * Detail
--
-- | 'ScrolledWindow' is a 'Bin' subclass: it's a container the accepts a
-- single child widget. 'ScrolledWindow' adds scrollbars to the child widget
-- and optionally draws a beveled frame around the child widget.
--
-- The scrolled window can work in two ways. Some widgets have native
-- scrolling support; these widgets have \"slots\" for 'Adjustment' objects.
-- Widgets with native scroll support include 'TreeView', 'TextView', and
-- 'Layout'.
--
-- For widgets that lack native scrolling support, the 'Viewport' widget
-- acts as an adaptor class, implementing scrollability for child widgets that
-- lack their own scrolling capabilities. Use 'Viewport' to scroll child
-- widgets such as 'Table', 'Box', and so on.
--
-- If a widget has native scrolling abilities, it can be added to the
-- 'ScrolledWindow' with 'Graphics.UI.Gtk.Abstract.Container.containerAdd'.
-- If a widget does not, you must first add the widget to a 'Viewport', then
-- add the 'Viewport' to the scrolled window. The convenience function
-- 'scrolledWindowAddWithViewport' does exactly this, so you can ignore the
-- presence of the viewport.
--
-- The position of the scrollbars is controlled by the scroll adjustments.
-- See 'Adjustment' for the fields in an adjustment - for 'Scrollbar', used by
-- 'ScrolledWindow', the \"value\" field represents the position of the
-- scrollbar, which must be between the \"lower\" field and \"upper -
-- page_size.\" The \"page_size\" field represents the size of the visible
-- scrollable area. The \"step_increment\" and \"page_increment\" fields are
-- used when the user asks to step down (using the small stepper arrows) or
-- page down (using for example the PageDown key).
--
-- If a 'ScrolledWindow' doesn't behave quite as you would like, or doesn't
-- have exactly the right layout, it's very possible to set up your own
-- scrolling with 'Scrollbar' and for example a 'Table'.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----'Widget'
-- | +----'Container'
-- | +----'Bin'
-- | +----ScrolledWindow
-- @

-- * Types
  ScrolledWindow,
  ScrolledWindowClass,
  castToScrolledWindow, gTypeScrolledWindow,
  toScrolledWindow,

-- * Constructors
  scrolledWindowNew,

-- * Methods
  scrolledWindowGetHAdjustment,
  scrolledWindowGetVAdjustment,
  PolicyType(..),
  scrolledWindowSetPolicy,
  scrolledWindowGetPolicy,
  scrolledWindowAddWithViewport,
  CornerType(..),
  scrolledWindowSetPlacement,
  scrolledWindowGetPlacement,
  ShadowType(..),
  scrolledWindowSetShadowType,
  scrolledWindowGetShadowType,






  scrolledWindowSetHAdjustment,
  scrolledWindowSetVAdjustment,

  scrolledWindowGetHScrollbar,
  scrolledWindowGetVScrollbar,
{-# LINE 117 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
-- * Attributes
  scrolledWindowHAdjustment,
  scrolledWindowVAdjustment,
  scrolledWindowHscrollbarPolicy,
  scrolledWindowVscrollbarPolicy,
  scrolledWindowWindowPlacement,
  scrolledWindowShadowType,




  scrolledWindowPlacement,



  ) where

import Control.Monad (liftM)
import Data.Maybe (fromMaybe)

import System.Glib.FFI
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Types
{-# LINE 142 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
import Graphics.UI.Gtk.General.Enums (PolicyType(..), CornerType(..), ShadowType(..))


{-# LINE 145 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}

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

-- | Creates a new scrolled window. The two arguments are the scrolled
-- window's adjustments; these will be shared with the scrollbars and the child
-- widget to keep the bars in sync with the child. Usually you want to pass
-- @Nothing@ for the adjustments, which will cause the scrolled window to
-- create them for you.
--
scrolledWindowNew ::
    Maybe Adjustment -- ^ @hadjustment@ - Horizontal adjustment.
 -> Maybe Adjustment -- ^ @vadjustment@ - Vertical adjustment.
 -> IO ScrolledWindow
scrolledWindowNew :: Maybe Adjustment -> Maybe Adjustment -> IO ScrolledWindow
scrolledWindowNew Maybe Adjustment
hadjustment Maybe Adjustment
vadjustment =
  (ForeignPtr ScrolledWindow -> ScrolledWindow,
 FinalizerPtr ScrolledWindow)
-> IO (Ptr ScrolledWindow) -> IO ScrolledWindow
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr ScrolledWindow -> ScrolledWindow,
 FinalizerPtr ScrolledWindow)
forall {a}.
(ForeignPtr ScrolledWindow -> ScrolledWindow, FinalizerPtr a)
mkScrolledWindow (IO (Ptr ScrolledWindow) -> IO ScrolledWindow)
-> IO (Ptr ScrolledWindow) -> IO ScrolledWindow
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr ScrolledWindow)
-> IO (Ptr Widget) -> IO (Ptr ScrolledWindow)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr ScrolledWindow
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr ScrolledWindow) (IO (Ptr Widget) -> IO (Ptr ScrolledWindow))
-> IO (Ptr Widget) -> IO (Ptr ScrolledWindow)
forall a b. (a -> b) -> a -> b
$
  (\(Adjustment ForeignPtr Adjustment
arg1) (Adjustment ForeignPtr Adjustment
arg2) -> ForeignPtr Adjustment
-> (Ptr Adjustment -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Adjustment
arg1 ((Ptr Adjustment -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Adjustment -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Adjustment
argPtr1 ->ForeignPtr Adjustment
-> (Ptr Adjustment -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Adjustment
arg2 ((Ptr Adjustment -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Adjustment -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Adjustment
argPtr2 ->Ptr Adjustment -> Ptr Adjustment -> IO (Ptr Widget)
gtk_scrolled_window_new Ptr Adjustment
argPtr1 Ptr Adjustment
argPtr2)
{-# LINE 163 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
    (fromMaybe (Adjustment nullForeignPtr) hadjustment)
    (Adjustment -> Maybe Adjustment -> Adjustment
forall a. a -> Maybe a -> a
fromMaybe (ForeignPtr Adjustment -> Adjustment
Adjustment ForeignPtr Adjustment
forall a. ForeignPtr a
nullForeignPtr) Maybe Adjustment
vadjustment)

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

-- | Returns the horizontal scrollbar's adjustment, used to connect the
-- horizontal scrollbar to the child widget's horizontal scroll functionality.
--
scrolledWindowGetHAdjustment :: ScrolledWindowClass self => self -> IO Adjustment
scrolledWindowGetHAdjustment :: forall self. ScrolledWindowClass self => self -> IO Adjustment
scrolledWindowGetHAdjustment self
self =
  (ForeignPtr Adjustment -> Adjustment, FinalizerPtr Adjustment)
-> IO (Ptr Adjustment) -> IO Adjustment
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Adjustment -> Adjustment, FinalizerPtr Adjustment)
forall {a}. (ForeignPtr Adjustment -> Adjustment, FinalizerPtr a)
mkAdjustment (IO (Ptr Adjustment) -> IO Adjustment)
-> IO (Ptr Adjustment) -> IO Adjustment
forall a b. (a -> b) -> a -> b
$
  (\(ScrolledWindow ForeignPtr ScrolledWindow
arg1) -> ForeignPtr ScrolledWindow
-> (Ptr ScrolledWindow -> IO (Ptr Adjustment))
-> IO (Ptr Adjustment)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ScrolledWindow
arg1 ((Ptr ScrolledWindow -> IO (Ptr Adjustment))
 -> IO (Ptr Adjustment))
-> (Ptr ScrolledWindow -> IO (Ptr Adjustment))
-> IO (Ptr Adjustment)
forall a b. (a -> b) -> a -> b
$ \Ptr ScrolledWindow
argPtr1 ->Ptr ScrolledWindow -> IO (Ptr Adjustment)
gtk_scrolled_window_get_hadjustment Ptr ScrolledWindow
argPtr1)
{-# LINE 176 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
    (toScrolledWindow self)

-- | Returns the vertical scrollbar's adjustment, used to connect the vertical
-- scrollbar to the child widget's vertical scroll functionality.
--
scrolledWindowGetVAdjustment :: ScrolledWindowClass self => self -> IO Adjustment
scrolledWindowGetVAdjustment :: forall self. ScrolledWindowClass self => self -> IO Adjustment
scrolledWindowGetVAdjustment self
self =
  (ForeignPtr Adjustment -> Adjustment, FinalizerPtr Adjustment)
-> IO (Ptr Adjustment) -> IO Adjustment
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Adjustment -> Adjustment, FinalizerPtr Adjustment)
forall {a}. (ForeignPtr Adjustment -> Adjustment, FinalizerPtr a)
mkAdjustment (IO (Ptr Adjustment) -> IO Adjustment)
-> IO (Ptr Adjustment) -> IO Adjustment
forall a b. (a -> b) -> a -> b
$
  (\(ScrolledWindow ForeignPtr ScrolledWindow
arg1) -> ForeignPtr ScrolledWindow
-> (Ptr ScrolledWindow -> IO (Ptr Adjustment))
-> IO (Ptr Adjustment)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ScrolledWindow
arg1 ((Ptr ScrolledWindow -> IO (Ptr Adjustment))
 -> IO (Ptr Adjustment))
-> (Ptr ScrolledWindow -> IO (Ptr Adjustment))
-> IO (Ptr Adjustment)
forall a b. (a -> b) -> a -> b
$ \Ptr ScrolledWindow
argPtr1 ->Ptr ScrolledWindow -> IO (Ptr Adjustment)
gtk_scrolled_window_get_vadjustment Ptr ScrolledWindow
argPtr1)
{-# LINE 185 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
    (toScrolledWindow self)

-- | Sets the scrollbar policy for the horizontal and vertical scrollbars. The
-- policy determines when the scrollbar should appear; it is a value from the
-- 'PolicyType' enumeration. If 'PolicyAlways', the scrollbar is always
-- present; if 'PolicyNever', the scrollbar is never present; if
-- 'PolicyAutomatic', the scrollbar is present only if needed (that is, if the
-- slider part of the bar would be smaller than the trough - the display is
-- larger than the page size).
--
scrolledWindowSetPolicy :: ScrolledWindowClass self => self
 -> PolicyType -- ^ @hscrollbarPolicy@ - Policy for horizontal bar.
 -> PolicyType -- ^ @vscrollbarPolicy@ - Policy for vertical bar.
 -> IO ()
scrolledWindowSetPolicy :: forall self.
ScrolledWindowClass self =>
self -> PolicyType -> PolicyType -> IO ()
scrolledWindowSetPolicy self
self PolicyType
hscrollbarPolicy PolicyType
vscrollbarPolicy =
  (\(ScrolledWindow ForeignPtr ScrolledWindow
arg1) CInt
arg2 CInt
arg3 -> ForeignPtr ScrolledWindow -> (Ptr ScrolledWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ScrolledWindow
arg1 ((Ptr ScrolledWindow -> IO ()) -> IO ())
-> (Ptr ScrolledWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ScrolledWindow
argPtr1 ->Ptr ScrolledWindow -> CInt -> CInt -> IO ()
gtk_scrolled_window_set_policy Ptr ScrolledWindow
argPtr1 CInt
arg2 CInt
arg3)
{-# LINE 201 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
    (toScrolledWindow self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (PolicyType -> Int) -> PolicyType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolicyType -> Int
forall a. Enum a => a -> Int
fromEnum) PolicyType
hscrollbarPolicy)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (PolicyType -> Int) -> PolicyType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolicyType -> Int
forall a. Enum a => a -> Int
fromEnum) PolicyType
vscrollbarPolicy)

-- | Retrieves the current policy values for the horizontal and vertical
-- scrollbars. See 'scrolledWindowSetPolicy'.
--
scrolledWindowGetPolicy :: ScrolledWindowClass self => self
 -> IO (PolicyType, PolicyType) -- ^ @(hscrollbarPolicy, vscrollbarPolicy)@
scrolledWindowGetPolicy :: forall self.
ScrolledWindowClass self =>
self -> IO (PolicyType, PolicyType)
scrolledWindowGetPolicy self
self =
  (Ptr CInt -> IO (PolicyType, PolicyType))
-> IO (PolicyType, PolicyType)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (PolicyType, PolicyType))
 -> IO (PolicyType, PolicyType))
-> (Ptr CInt -> IO (PolicyType, PolicyType))
-> IO (PolicyType, PolicyType)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
hPolPtr ->
  (Ptr CInt -> IO (PolicyType, PolicyType))
-> IO (PolicyType, PolicyType)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (PolicyType, PolicyType))
 -> IO (PolicyType, PolicyType))
-> (Ptr CInt -> IO (PolicyType, PolicyType))
-> IO (PolicyType, PolicyType)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
vPolPtr -> do
  (\(ScrolledWindow ForeignPtr ScrolledWindow
arg1) Ptr CInt
arg2 Ptr CInt
arg3 -> ForeignPtr ScrolledWindow -> (Ptr ScrolledWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ScrolledWindow
arg1 ((Ptr ScrolledWindow -> IO ()) -> IO ())
-> (Ptr ScrolledWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ScrolledWindow
argPtr1 ->Ptr ScrolledWindow -> Ptr CInt -> Ptr CInt -> IO ()
gtk_scrolled_window_get_policy Ptr ScrolledWindow
argPtr1 Ptr CInt
arg2 Ptr CInt
arg3)
{-# LINE 214 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
    (toScrolledWindow self)
    Ptr CInt
hPolPtr Ptr CInt
vPolPtr
  PolicyType
hPol <- (CInt -> PolicyType) -> IO CInt -> IO PolicyType
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> PolicyType
forall a. Enum a => Int -> a
toEnum(Int -> PolicyType) -> (CInt -> Int) -> CInt -> PolicyType
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 PolicyType) -> IO CInt -> IO PolicyType
forall a b. (a -> b) -> a -> b
$ Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
hPolPtr
  PolicyType
vPol <- (CInt -> PolicyType) -> IO CInt -> IO PolicyType
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> PolicyType
forall a. Enum a => Int -> a
toEnum(Int -> PolicyType) -> (CInt -> Int) -> CInt -> PolicyType
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 PolicyType) -> IO CInt -> IO PolicyType
forall a b. (a -> b) -> a -> b
$ Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
vPolPtr
  (PolicyType, PolicyType) -> IO (PolicyType, PolicyType)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PolicyType
hPol, PolicyType
vPol)

-- | Used to add children without native scrolling capabilities. This is
-- simply a convenience function; it is equivalent to adding the unscrollable
-- child to a viewport, then adding the viewport to the scrolled window. If a
-- child has native scrolling, use
-- 'Graphics.UI.Gtk.Abstract.Container.containerAdd' instead of this function.
--
-- The viewport scrolls the child by moving its 'DrawWindow', and takes the
-- size of the child to be the size of its toplevel 'DrawWindow'. This will be
-- very wrong for most widgets that support native scrolling; for example, if
-- you add a widget such as 'TreeView' with a viewport, the whole widget will
-- scroll, including the column headings. Thus, widgets with native scrolling
-- support should not be used with the 'Viewport' proxy.
--
scrolledWindowAddWithViewport :: (ScrolledWindowClass self, WidgetClass child) => self
 -> child -- ^ @child@ - Widget you want to scroll.
 -> IO ()
scrolledWindowAddWithViewport :: forall self child.
(ScrolledWindowClass self, WidgetClass child) =>
self -> child -> IO ()
scrolledWindowAddWithViewport self
self child
child =
  (\(ScrolledWindow ForeignPtr ScrolledWindow
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr ScrolledWindow -> (Ptr ScrolledWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ScrolledWindow
arg1 ((Ptr ScrolledWindow -> IO ()) -> IO ())
-> (Ptr ScrolledWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ScrolledWindow
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 ScrolledWindow -> Ptr Widget -> IO ()
gtk_scrolled_window_add_with_viewport Ptr ScrolledWindow
argPtr1 Ptr Widget
argPtr2)
{-# LINE 238 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
    (toScrolledWindow self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)

-- | Determines the location of the child widget with respect to the
-- scrollbars. The default is 'CornerTopLeft', meaning the child is in the top
-- left, with the scrollbars underneath and to the right. Other values in
-- 'CornerType' are 'CornerTopRight', 'CornerBottomLeft', and
-- 'CornerBottomRight'.
--
scrolledWindowSetPlacement :: ScrolledWindowClass self => self
 -> CornerType -- ^ @windowPlacement@ - Position of the child window.
 -> IO ()
scrolledWindowSetPlacement :: forall self.
ScrolledWindowClass self =>
self -> CornerType -> IO ()
scrolledWindowSetPlacement self
self CornerType
windowPlacement =
  (\(ScrolledWindow ForeignPtr ScrolledWindow
arg1) CInt
arg2 -> ForeignPtr ScrolledWindow -> (Ptr ScrolledWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ScrolledWindow
arg1 ((Ptr ScrolledWindow -> IO ()) -> IO ())
-> (Ptr ScrolledWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ScrolledWindow
argPtr1 ->Ptr ScrolledWindow -> CInt -> IO ()
gtk_scrolled_window_set_placement Ptr ScrolledWindow
argPtr1 CInt
arg2)
{-# LINE 252 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
    (toScrolledWindow self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (CornerType -> Int) -> CornerType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CornerType -> Int
forall a. Enum a => a -> Int
fromEnum) CornerType
windowPlacement)

-- | Gets the placement of the scrollbars for the scrolled window. See
-- 'scrolledWindowSetPlacement'.
--
scrolledWindowGetPlacement :: ScrolledWindowClass self => self -> IO CornerType
scrolledWindowGetPlacement :: forall self. ScrolledWindowClass self => self -> IO CornerType
scrolledWindowGetPlacement self
self =
  (CInt -> CornerType) -> IO CInt -> IO CornerType
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> CornerType
forall a. Enum a => Int -> a
toEnum (Int -> CornerType) -> (CInt -> Int) -> CInt -> CornerType
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 CornerType) -> IO CInt -> IO CornerType
forall a b. (a -> b) -> a -> b
$
  (\(ScrolledWindow ForeignPtr ScrolledWindow
arg1) -> ForeignPtr ScrolledWindow
-> (Ptr ScrolledWindow -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ScrolledWindow
arg1 ((Ptr ScrolledWindow -> IO CInt) -> IO CInt)
-> (Ptr ScrolledWindow -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr ScrolledWindow
argPtr1 ->Ptr ScrolledWindow -> IO CInt
gtk_scrolled_window_get_placement Ptr ScrolledWindow
argPtr1)
{-# LINE 262 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
    (toScrolledWindow self)

-- | Changes the type of shadow drawn around the contents of @scrolledWindow@.
--
scrolledWindowSetShadowType :: ScrolledWindowClass self => self -> ShadowType -> IO ()
scrolledWindowSetShadowType :: forall self.
ScrolledWindowClass self =>
self -> ShadowType -> IO ()
scrolledWindowSetShadowType self
self ShadowType
type_ =
  (\(ScrolledWindow ForeignPtr ScrolledWindow
arg1) CInt
arg2 -> ForeignPtr ScrolledWindow -> (Ptr ScrolledWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ScrolledWindow
arg1 ((Ptr ScrolledWindow -> IO ()) -> IO ())
-> (Ptr ScrolledWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ScrolledWindow
argPtr1 ->Ptr ScrolledWindow -> CInt -> IO ()
gtk_scrolled_window_set_shadow_type Ptr ScrolledWindow
argPtr1 CInt
arg2)
{-# LINE 269 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
    (toScrolledWindow self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (ShadowType -> Int) -> ShadowType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShadowType -> Int
forall a. Enum a => a -> Int
fromEnum) ShadowType
type_)

-- | Gets the shadow type of the scrolled window. See
-- 'scrolledWindowSetShadowType'.
--
scrolledWindowGetShadowType :: ScrolledWindowClass self => self -> IO ShadowType
scrolledWindowGetShadowType :: forall self. ScrolledWindowClass self => self -> IO ShadowType
scrolledWindowGetShadowType self
self =
  (CInt -> ShadowType) -> IO CInt -> IO ShadowType
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> ShadowType
forall a. Enum a => Int -> a
toEnum (Int -> ShadowType) -> (CInt -> Int) -> CInt -> ShadowType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO ShadowType) -> IO CInt -> IO ShadowType
forall a b. (a -> b) -> a -> b
$
  (\(ScrolledWindow ForeignPtr ScrolledWindow
arg1) -> ForeignPtr ScrolledWindow
-> (Ptr ScrolledWindow -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ScrolledWindow
arg1 ((Ptr ScrolledWindow -> IO CInt) -> IO CInt)
-> (Ptr ScrolledWindow -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr ScrolledWindow
argPtr1 ->Ptr ScrolledWindow -> IO CInt
gtk_scrolled_window_get_shadow_type Ptr ScrolledWindow
argPtr1)
{-# LINE 279 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
    (toScrolledWindow self)
{-# LINE 317 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
-- | Sets the 'Adjustment' for the horizontal scrollbar.
--
scrolledWindowSetHAdjustment :: ScrolledWindowClass self => self -> Adjustment -> IO ()
scrolledWindowSetHAdjustment :: forall self.
ScrolledWindowClass self =>
self -> Adjustment -> IO ()
scrolledWindowSetHAdjustment self
self Adjustment
hadjustment =
  (\(ScrolledWindow ForeignPtr ScrolledWindow
arg1) (Adjustment ForeignPtr Adjustment
arg2) -> ForeignPtr ScrolledWindow -> (Ptr ScrolledWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ScrolledWindow
arg1 ((Ptr ScrolledWindow -> IO ()) -> IO ())
-> (Ptr ScrolledWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ScrolledWindow
argPtr1 ->ForeignPtr Adjustment -> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Adjustment
arg2 ((Ptr Adjustment -> IO ()) -> IO ())
-> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Adjustment
argPtr2 ->Ptr ScrolledWindow -> Ptr Adjustment -> IO ()
gtk_scrolled_window_set_hadjustment Ptr ScrolledWindow
argPtr1 Ptr Adjustment
argPtr2)
{-# LINE 322 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
    (toScrolledWindow self)
    Adjustment
hadjustment

-- | Sets the 'Adjustment' for the vertical scrollbar.
--
scrolledWindowSetVAdjustment :: ScrolledWindowClass self => self
 -> Adjustment -- ^ @vadjustment@ - Vertical scroll adjustment.
 -> IO ()
scrolledWindowSetVAdjustment :: forall self.
ScrolledWindowClass self =>
self -> Adjustment -> IO ()
scrolledWindowSetVAdjustment self
self Adjustment
vadjustment =
  (\(ScrolledWindow ForeignPtr ScrolledWindow
arg1) (Adjustment ForeignPtr Adjustment
arg2) -> ForeignPtr ScrolledWindow -> (Ptr ScrolledWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ScrolledWindow
arg1 ((Ptr ScrolledWindow -> IO ()) -> IO ())
-> (Ptr ScrolledWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ScrolledWindow
argPtr1 ->ForeignPtr Adjustment -> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Adjustment
arg2 ((Ptr Adjustment -> IO ()) -> IO ())
-> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Adjustment
argPtr2 ->Ptr ScrolledWindow -> Ptr Adjustment -> IO ()
gtk_scrolled_window_set_vadjustment Ptr ScrolledWindow
argPtr1 Ptr Adjustment
argPtr2)
{-# LINE 332 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
    (toScrolledWindow self)
    Adjustment
vadjustment


-- | Returns the horizontal scrollbar of @scrolledWindow@.
--
-- * Available since Gtk+ version 2.8
--
scrolledWindowGetHScrollbar :: ScrolledWindowClass self => self
 -> IO (Maybe HScrollbar) -- ^ returns the horizontal scrollbar of the scrolled
                          -- window, or @Nothing@ if it does not have one.
scrolledWindowGetHScrollbar :: forall self.
ScrolledWindowClass self =>
self -> IO (Maybe HScrollbar)
scrolledWindowGetHScrollbar self
self =
  (IO (Ptr HScrollbar) -> IO HScrollbar)
-> IO (Ptr HScrollbar) -> IO (Maybe HScrollbar)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr HScrollbar -> HScrollbar, FinalizerPtr HScrollbar)
-> IO (Ptr HScrollbar) -> IO HScrollbar
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr HScrollbar -> HScrollbar, FinalizerPtr HScrollbar)
forall {a}. (ForeignPtr HScrollbar -> HScrollbar, FinalizerPtr a)
mkHScrollbar) (IO (Ptr HScrollbar) -> IO (Maybe HScrollbar))
-> IO (Ptr HScrollbar) -> IO (Maybe HScrollbar)
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr HScrollbar)
-> IO (Ptr Widget) -> IO (Ptr HScrollbar)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr HScrollbar
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr HScrollbar) (IO (Ptr Widget) -> IO (Ptr HScrollbar))
-> IO (Ptr Widget) -> IO (Ptr HScrollbar)
forall a b. (a -> b) -> a -> b
$
  (\(ScrolledWindow ForeignPtr ScrolledWindow
arg1) -> ForeignPtr ScrolledWindow
-> (Ptr ScrolledWindow -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ScrolledWindow
arg1 ((Ptr ScrolledWindow -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr ScrolledWindow -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr ScrolledWindow
argPtr1 ->Ptr ScrolledWindow -> IO (Ptr Widget)
gtk_scrolled_window_get_hscrollbar Ptr ScrolledWindow
argPtr1)
{-# LINE 347 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
    (toScrolledWindow self)

-- | Returns the vertical scrollbar of @scrolledWindow@.
--
-- * Available since Gtk+ version 2.8
--
scrolledWindowGetVScrollbar :: ScrolledWindowClass self => self
 -> IO (Maybe VScrollbar) -- ^ returns the vertical scrollbar of the scrolled
                          -- window, or @Nothing@ if it does not have one.
scrolledWindowGetVScrollbar :: forall self.
ScrolledWindowClass self =>
self -> IO (Maybe VScrollbar)
scrolledWindowGetVScrollbar self
self =
  (IO (Ptr VScrollbar) -> IO VScrollbar)
-> IO (Ptr VScrollbar) -> IO (Maybe VScrollbar)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr VScrollbar -> VScrollbar, FinalizerPtr VScrollbar)
-> IO (Ptr VScrollbar) -> IO VScrollbar
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr VScrollbar -> VScrollbar, FinalizerPtr VScrollbar)
forall {a}. (ForeignPtr VScrollbar -> VScrollbar, FinalizerPtr a)
mkVScrollbar) (IO (Ptr VScrollbar) -> IO (Maybe VScrollbar))
-> IO (Ptr VScrollbar) -> IO (Maybe VScrollbar)
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr VScrollbar)
-> IO (Ptr Widget) -> IO (Ptr VScrollbar)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr VScrollbar
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr VScrollbar) (IO (Ptr Widget) -> IO (Ptr VScrollbar))
-> IO (Ptr Widget) -> IO (Ptr VScrollbar)
forall a b. (a -> b) -> a -> b
$
  (\(ScrolledWindow ForeignPtr ScrolledWindow
arg1) -> ForeignPtr ScrolledWindow
-> (Ptr ScrolledWindow -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ScrolledWindow
arg1 ((Ptr ScrolledWindow -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr ScrolledWindow -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr ScrolledWindow
argPtr1 ->Ptr ScrolledWindow -> IO (Ptr Widget)
gtk_scrolled_window_get_vscrollbar Ptr ScrolledWindow
argPtr1)
{-# LINE 360 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
    (toScrolledWindow self)
{-# LINE 408 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
--------------------
-- Attributes

-- | The 'Adjustment' for the horizontal position.
--
scrolledWindowHAdjustment :: ScrolledWindowClass self => Attr self Adjustment
scrolledWindowHAdjustment :: forall self. ScrolledWindowClass self => Attr self Adjustment
scrolledWindowHAdjustment = (self -> IO Adjustment)
-> (self -> Adjustment -> IO ())
-> ReadWriteAttr self Adjustment Adjustment
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Adjustment
forall self. ScrolledWindowClass self => self -> IO Adjustment
scrolledWindowGetHAdjustment
  self -> Adjustment -> IO ()
forall self.
ScrolledWindowClass self =>
self -> Adjustment -> IO ()
scrolledWindowSetHAdjustment

-- | The 'Adjustment' for the vertical position.
--
scrolledWindowVAdjustment :: ScrolledWindowClass self => Attr self Adjustment
scrolledWindowVAdjustment :: forall self. ScrolledWindowClass self => Attr self Adjustment
scrolledWindowVAdjustment = (self -> IO Adjustment)
-> (self -> Adjustment -> IO ())
-> ReadWriteAttr self Adjustment Adjustment
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Adjustment
forall self. ScrolledWindowClass self => self -> IO Adjustment
scrolledWindowGetVAdjustment
  self -> Adjustment -> IO ()
forall self.
ScrolledWindowClass self =>
self -> Adjustment -> IO ()
scrolledWindowSetVAdjustment

-- | When the horizontal scrollbar is displayed.
--
-- Default value: 'PolicyAlways'
--
scrolledWindowHscrollbarPolicy :: ScrolledWindowClass self => Attr self PolicyType
scrolledWindowHscrollbarPolicy :: forall self. ScrolledWindowClass self => Attr self PolicyType
scrolledWindowHscrollbarPolicy = String -> GType -> Attr self PolicyType
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
String -> GType -> Attr gobj enum
newAttrFromEnumProperty String
"hscrollbar-policy"
  GType
gtk_policy_type_get_type
{-# LINE 432 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}

-- | When the vertical scrollbar is displayed.
--
-- Default value: 'PolicyAlways'
--
scrolledWindowVscrollbarPolicy :: ScrolledWindowClass self => Attr self PolicyType
scrolledWindowVscrollbarPolicy :: forall self. ScrolledWindowClass self => Attr self PolicyType
scrolledWindowVscrollbarPolicy = String -> GType -> Attr self PolicyType
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
String -> GType -> Attr gobj enum
newAttrFromEnumProperty String
"vscrollbar-policy"
  GType
gtk_policy_type_get_type
{-# LINE 440 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}

-- | Where the contents are located with respect to the scrollbars.
--
-- Default value: 'CornerTopLeft'
--
scrolledWindowWindowPlacement :: ScrolledWindowClass self => Attr self CornerType
scrolledWindowWindowPlacement :: forall self. ScrolledWindowClass self => Attr self CornerType
scrolledWindowWindowPlacement = String -> GType -> Attr self CornerType
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
String -> GType -> Attr gobj enum
newAttrFromEnumProperty String
"window-placement"
  GType
gtk_corner_type_get_type
{-# LINE 448 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}

-- | Style of bevel around the contents.
--
-- Default value: 'ShadowNone'
--
scrolledWindowShadowType :: ScrolledWindowClass self => Attr self ShadowType
scrolledWindowShadowType :: forall self. ScrolledWindowClass self => Attr self ShadowType
scrolledWindowShadowType = (self -> IO ShadowType)
-> (self -> ShadowType -> IO ())
-> ReadWriteAttr self ShadowType ShadowType
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO ShadowType
forall self. ScrolledWindowClass self => self -> IO ShadowType
scrolledWindowGetShadowType
  self -> ShadowType -> IO ()
forall self.
ScrolledWindowClass self =>
self -> ShadowType -> IO ()
scrolledWindowSetShadowType
{-# LINE 478 "./Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs" #-}
-- | \'placement\' property. See 'scrolledWindowGetPlacement' and
-- 'scrolledWindowSetPlacement'
--
scrolledWindowPlacement :: ScrolledWindowClass self => Attr self CornerType
scrolledWindowPlacement :: forall self. ScrolledWindowClass self => Attr self CornerType
scrolledWindowPlacement = (self -> IO CornerType)
-> (self -> CornerType -> IO ())
-> ReadWriteAttr self CornerType CornerType
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO CornerType
forall self. ScrolledWindowClass self => self -> IO CornerType
scrolledWindowGetPlacement
  self -> CornerType -> IO ()
forall self.
ScrolledWindowClass self =>
self -> CornerType -> IO ()
scrolledWindowSetPlacement

foreign import ccall unsafe "gtk_scrolled_window_new"
  gtk_scrolled_window_new :: ((Ptr Adjustment) -> ((Ptr Adjustment) -> (IO (Ptr Widget))))

foreign import ccall unsafe "gtk_scrolled_window_get_hadjustment"
  gtk_scrolled_window_get_hadjustment :: ((Ptr ScrolledWindow) -> (IO (Ptr Adjustment)))

foreign import ccall unsafe "gtk_scrolled_window_get_vadjustment"
  gtk_scrolled_window_get_vadjustment :: ((Ptr ScrolledWindow) -> (IO (Ptr Adjustment)))

foreign import ccall safe "gtk_scrolled_window_set_policy"
  gtk_scrolled_window_set_policy :: ((Ptr ScrolledWindow) -> (CInt -> (CInt -> (IO ()))))

foreign import ccall unsafe "gtk_scrolled_window_get_policy"
  gtk_scrolled_window_get_policy :: ((Ptr ScrolledWindow) -> ((Ptr CInt) -> ((Ptr CInt) -> (IO ()))))

foreign import ccall safe "gtk_scrolled_window_add_with_viewport"
  gtk_scrolled_window_add_with_viewport :: ((Ptr ScrolledWindow) -> ((Ptr Widget) -> (IO ())))

foreign import ccall safe "gtk_scrolled_window_set_placement"
  gtk_scrolled_window_set_placement :: ((Ptr ScrolledWindow) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_scrolled_window_get_placement"
  gtk_scrolled_window_get_placement :: ((Ptr ScrolledWindow) -> (IO CInt))

foreign import ccall safe "gtk_scrolled_window_set_shadow_type"
  gtk_scrolled_window_set_shadow_type :: ((Ptr ScrolledWindow) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_scrolled_window_get_shadow_type"
  gtk_scrolled_window_get_shadow_type :: ((Ptr ScrolledWindow) -> (IO CInt))

foreign import ccall safe "gtk_scrolled_window_set_hadjustment"
  gtk_scrolled_window_set_hadjustment :: ((Ptr ScrolledWindow) -> ((Ptr Adjustment) -> (IO ())))

foreign import ccall safe "gtk_scrolled_window_set_vadjustment"
  gtk_scrolled_window_set_vadjustment :: ((Ptr ScrolledWindow) -> ((Ptr Adjustment) -> (IO ())))

foreign import ccall safe "gtk_scrolled_window_get_hscrollbar"
  gtk_scrolled_window_get_hscrollbar :: ((Ptr ScrolledWindow) -> (IO (Ptr Widget)))

foreign import ccall safe "gtk_scrolled_window_get_vscrollbar"
  gtk_scrolled_window_get_vscrollbar :: ((Ptr ScrolledWindow) -> (IO (Ptr Widget)))

foreign import ccall unsafe "gtk_policy_type_get_type"
  gtk_policy_type_get_type :: CUInt

foreign import ccall unsafe "gtk_corner_type_get_type"
  gtk_corner_type_get_type :: CUInt