{-# LINE 2 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget PageSetup
--
-- Author : Andy Stewart
--
-- Created: 28 Mar 2010
--
-- Copyright (C) 2010 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)
--
-- Stores page setup information
--
-- * Module available since Gtk+ version 2.10
--
module Graphics.UI.Gtk.Printing.PageSetup (

-- * Detail
--
-- | A 'PageSetup' object stores the page size, orientation and margins. The
-- idea is that you can get one of these from the page setup dialog and then
-- pass it to the 'PrintOperation' when printing. The benefit of splitting this
-- out of the 'PrintSettings' is that these affect the actual layout of the
-- page, and thus need to be set long before user prints.
--
-- The margins specified in this object are the \"print margins\", i.e. the
-- parts of the page that the printer cannot print on. These are different from
-- the layout margins that a word processor uses; they are typically used to
-- determine the /minimal/ size for the layout margins.
--
-- To obtain a 'PageSetup' use 'pageSetupNew' to get the defaults, or use
-- 'printRunPageSetupDialog' to show the page setup dialog and receive the
-- resulting page setup.
--
-- Printing support was added in Gtk+ 2.10.
--

-- * Class Hierarchy
--
-- |
-- @
-- | 'GObject'
-- | +----PageSetup
-- @


-- * Types
  PageSetup,
  PageSetupClass,
  castToPageSetup,
  toPageSetup,

-- * Constructors
  pageSetupNew,

  pageSetupNewFromFile,


-- * Methods
  pageSetupCopy,
  pageSetupGetTopMargin,
  pageSetupSetTopMargin,
  pageSetupGetBottomMargin,
  pageSetupSetBottomMargin,
  pageSetupGetLeftMargin,
  pageSetupSetLeftMargin,
  pageSetupGetRightMargin,
  pageSetupSetRightMargin,
  pageSetupSetPaperSizeAndDefaultMargins,
  pageSetupGetPaperWidth,
  pageSetupGetPaperHeight,
  pageSetupGetPageWidth,
  pageSetupGetPageHeight,

  pageSetupLoadFile,


  pageSetupToFile,


-- * Attributes
  pageSetupOrientation,
  pageSetupPaperSize,

  ) where

import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.GError
import System.Glib.Attributes
import System.Glib.UTFString
import Graphics.UI.Gtk.Types
{-# LINE 108 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
import Graphics.UI.Gtk.Printing.PaperSize (PaperSize(..), mkPaperSize, Unit(..))
import Graphics.UI.Gtk.Printing.PrintSettings (PageOrientation (..))


{-# LINE 112 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}


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

-- | Creates a new 'PageSetup'.
--
pageSetupNew :: IO PageSetup
pageSetupNew :: IO PageSetup
pageSetupNew =
  (ForeignPtr PageSetup -> PageSetup, FinalizerPtr PageSetup)
-> IO (Ptr PageSetup) -> IO PageSetup
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr PageSetup -> PageSetup, FinalizerPtr PageSetup)
forall {a}. (ForeignPtr PageSetup -> PageSetup, FinalizerPtr a)
mkPageSetup (IO (Ptr PageSetup) -> IO PageSetup)
-> IO (Ptr PageSetup) -> IO PageSetup
forall a b. (a -> b) -> a -> b
$
  IO (Ptr PageSetup)
gtk_page_setup_new
{-# LINE 123 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}


-- | Reads the page setup from the file @fileName@. Returns a new 'PageSetup'
-- object with the restored page setup.
--
-- * Available since Gtk+ version 2.12
--
pageSetupNewFromFile :: GlibString string
 => string -- ^ @fileName@ - the filename to read the page setup from
 -> IO PageSetup
pageSetupNewFromFile :: forall string. GlibString string => string -> IO PageSetup
pageSetupNewFromFile string
fileName =
  (Ptr (Ptr ()) -> IO PageSetup) -> IO PageSetup
forall a. (Ptr (Ptr ()) -> IO a) -> IO a
propagateGError ((Ptr (Ptr ()) -> IO PageSetup) -> IO PageSetup)
-> (Ptr (Ptr ()) -> IO PageSetup) -> IO PageSetup
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
errorPtr ->
  string -> (CString -> IO PageSetup) -> IO PageSetup
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
fileName ((CString -> IO PageSetup) -> IO PageSetup)
-> (CString -> IO PageSetup) -> IO PageSetup
forall a b. (a -> b) -> a -> b
$ \CString
fileNamePtr -> do
  Ptr PageSetup
setupPtr <- CString -> Ptr (Ptr ()) -> IO (Ptr PageSetup)
gtk_page_setup_new_from_file
{-# LINE 137 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
             CString
fileNamePtr
             Ptr (Ptr ())
errorPtr
  (ForeignPtr PageSetup -> PageSetup, FinalizerPtr PageSetup)
-> IO (Ptr PageSetup) -> IO PageSetup
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr PageSetup -> PageSetup, FinalizerPtr PageSetup)
forall {a}. (ForeignPtr PageSetup -> PageSetup, FinalizerPtr a)
mkPageSetup (Ptr PageSetup -> IO (Ptr PageSetup)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr PageSetup
setupPtr)



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

-- | Copies a 'PageSetup'.
--
pageSetupCopy :: PageSetupClass self => self
 -> IO PageSetup -- ^ returns a copy of @other@
pageSetupCopy :: forall self. PageSetupClass self => self -> IO PageSetup
pageSetupCopy self
self =
  (ForeignPtr PageSetup -> PageSetup, FinalizerPtr PageSetup)
-> IO (Ptr PageSetup) -> IO PageSetup
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr PageSetup -> PageSetup, FinalizerPtr PageSetup)
forall {a}. (ForeignPtr PageSetup -> PageSetup, FinalizerPtr a)
mkPageSetup (IO (Ptr PageSetup) -> IO PageSetup)
-> IO (Ptr PageSetup) -> IO PageSetup
forall a b. (a -> b) -> a -> b
$
  (\(PageSetup ForeignPtr PageSetup
arg1) -> ForeignPtr PageSetup
-> (Ptr PageSetup -> IO (Ptr PageSetup)) -> IO (Ptr PageSetup)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO (Ptr PageSetup)) -> IO (Ptr PageSetup))
-> (Ptr PageSetup -> IO (Ptr PageSetup)) -> IO (Ptr PageSetup)
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->Ptr PageSetup -> IO (Ptr PageSetup)
gtk_page_setup_copy Ptr PageSetup
argPtr1)
{-# LINE 153 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)

-- | Gets the page orientation of the 'PageSetup'.
pageSetupGetOrientation :: PageSetupClass self => self
 -> IO PageOrientation -- ^ returns the page orientation
pageSetupGetOrientation :: forall self. PageSetupClass self => self -> IO PageOrientation
pageSetupGetOrientation self
self =
  (CInt -> PageOrientation) -> IO CInt -> IO PageOrientation
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> PageOrientation
forall a. Enum a => Int -> a
toEnum (Int -> PageOrientation)
-> (CInt -> Int) -> CInt -> PageOrientation
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 PageOrientation) -> IO CInt -> IO PageOrientation
forall a b. (a -> b) -> a -> b
$
  (\(PageSetup ForeignPtr PageSetup
arg1) -> ForeignPtr PageSetup -> (Ptr PageSetup -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO CInt) -> IO CInt)
-> (Ptr PageSetup -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->Ptr PageSetup -> IO CInt
gtk_page_setup_get_orientation Ptr PageSetup
argPtr1)
{-# LINE 161 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)

-- | Sets the page orientation of the 'PageSetup'.
pageSetupSetOrientation :: PageSetupClass self => self
 -> PageOrientation -- ^ @orientation@ - a 'PageOrientation' value
 -> IO ()
pageSetupSetOrientation :: forall self.
PageSetupClass self =>
self -> PageOrientation -> IO ()
pageSetupSetOrientation self
self PageOrientation
orientation =
  (\(PageSetup ForeignPtr PageSetup
arg1) CInt
arg2 -> ForeignPtr PageSetup -> (Ptr PageSetup -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO ()) -> IO ())
-> (Ptr PageSetup -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->Ptr PageSetup -> CInt -> IO ()
gtk_page_setup_set_orientation Ptr PageSetup
argPtr1 CInt
arg2)
{-# LINE 169 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt)
-> (PageOrientation -> Int) -> PageOrientation -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PageOrientation -> Int
forall a. Enum a => a -> Int
fromEnum) PageOrientation
orientation)

-- | Gets the paper size of the 'PageSetup'.
pageSetupGetPaperSize :: PageSetupClass self => self
 -> IO PaperSize -- ^ returns the paper size
pageSetupGetPaperSize :: forall self. PageSetupClass self => self -> IO PaperSize
pageSetupGetPaperSize self
self =
  (\(PageSetup ForeignPtr PageSetup
arg1) -> ForeignPtr PageSetup
-> (Ptr PageSetup -> IO (Ptr PaperSize)) -> IO (Ptr PaperSize)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO (Ptr PaperSize)) -> IO (Ptr PaperSize))
-> (Ptr PageSetup -> IO (Ptr PaperSize)) -> IO (Ptr PaperSize)
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->Ptr PageSetup -> IO (Ptr PaperSize)
gtk_page_setup_get_paper_size Ptr PageSetup
argPtr1)
{-# LINE 177 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)
  IO (Ptr PaperSize)
-> (Ptr PaperSize -> IO PaperSize) -> IO PaperSize
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr PaperSize -> IO PaperSize
mkPaperSize (Ptr PaperSize -> IO PaperSize)
-> (Ptr PaperSize -> Ptr PaperSize)
-> Ptr PaperSize
-> IO PaperSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr PaperSize -> Ptr PaperSize
forall a b. Ptr a -> Ptr b
castPtr

pageSetupSetPaperSize :: PageSetupClass self => self
 -> PaperSize -- ^ @size@ - a 'PaperSize'
 -> IO ()
pageSetupSetPaperSize :: forall self. PageSetupClass self => self -> PaperSize -> IO ()
pageSetupSetPaperSize self
self PaperSize
size =
  (\(PageSetup ForeignPtr PageSetup
arg1) (PaperSize ForeignPtr PaperSize
arg2) -> ForeignPtr PageSetup -> (Ptr PageSetup -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO ()) -> IO ())
-> (Ptr PageSetup -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->ForeignPtr PaperSize -> (Ptr PaperSize -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PaperSize
arg2 ((Ptr PaperSize -> IO ()) -> IO ())
-> (Ptr PaperSize -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PaperSize
argPtr2 ->Ptr PageSetup -> Ptr PaperSize -> IO ()
gtk_page_setup_set_paper_size Ptr PageSetup
argPtr1 Ptr PaperSize
argPtr2)
{-# LINE 185 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)
    PaperSize
size

-- | Gets the top margin in units of @unit@.
--
pageSetupGetTopMargin :: PageSetupClass self => self
 -> Unit -- ^ @unit@ - the unit for the return value
 -> IO Double -- ^ returns the top margin
pageSetupGetTopMargin :: forall self. PageSetupClass self => self -> Unit -> IO Double
pageSetupGetTopMargin self
self Unit
unit =
  (CDouble -> Double) -> IO CDouble -> IO Double
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (IO CDouble -> IO Double) -> IO CDouble -> IO Double
forall a b. (a -> b) -> a -> b
$
  (\(PageSetup ForeignPtr PageSetup
arg1) CInt
arg2 -> ForeignPtr PageSetup -> (Ptr PageSetup -> IO CDouble) -> IO CDouble
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO CDouble) -> IO CDouble)
-> (Ptr PageSetup -> IO CDouble) -> IO CDouble
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->Ptr PageSetup -> CInt -> IO CDouble
gtk_page_setup_get_top_margin Ptr PageSetup
argPtr1 CInt
arg2)
{-# LINE 196 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Unit -> Int) -> Unit -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> Int
forall a. Enum a => a -> Int
fromEnum) Unit
unit)

-- | Sets the top margin of the 'PageSetup'.
--
pageSetupSetTopMargin :: PageSetupClass self => self
 -> Double -- ^ @margin@ - the new top margin in units of @unit@
 -> Unit -- ^ @unit@ - the units for @margin@
 -> IO ()
pageSetupSetTopMargin :: forall self. PageSetupClass self => self -> Double -> Unit -> IO ()
pageSetupSetTopMargin self
self Double
margin Unit
unit =
  (\(PageSetup ForeignPtr PageSetup
arg1) CDouble
arg2 CInt
arg3 -> ForeignPtr PageSetup -> (Ptr PageSetup -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO ()) -> IO ())
-> (Ptr PageSetup -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->Ptr PageSetup -> CDouble -> CInt -> IO ()
gtk_page_setup_set_top_margin Ptr PageSetup
argPtr1 CDouble
arg2 CInt
arg3)
{-# LINE 207 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
margin)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Unit -> Int) -> Unit -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> Int
forall a. Enum a => a -> Int
fromEnum) Unit
unit)

-- | Gets the bottom margin in units of @unit@.
--
pageSetupGetBottomMargin :: PageSetupClass self => self
 -> Unit -- ^ @unit@ - the unit for the return value
 -> IO Double -- ^ returns the bottom margin
pageSetupGetBottomMargin :: forall self. PageSetupClass self => self -> Unit -> IO Double
pageSetupGetBottomMargin self
self Unit
unit =
  (CDouble -> Double) -> IO CDouble -> IO Double
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (IO CDouble -> IO Double) -> IO CDouble -> IO Double
forall a b. (a -> b) -> a -> b
$
  (\(PageSetup ForeignPtr PageSetup
arg1) CInt
arg2 -> ForeignPtr PageSetup -> (Ptr PageSetup -> IO CDouble) -> IO CDouble
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO CDouble) -> IO CDouble)
-> (Ptr PageSetup -> IO CDouble) -> IO CDouble
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->Ptr PageSetup -> CInt -> IO CDouble
gtk_page_setup_get_bottom_margin Ptr PageSetup
argPtr1 CInt
arg2)
{-# LINE 219 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Unit -> Int) -> Unit -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> Int
forall a. Enum a => a -> Int
fromEnum) Unit
unit)

-- | Sets the bottom margin of the 'PageSetup'.
--
pageSetupSetBottomMargin :: PageSetupClass self => self
 -> Double -- ^ @margin@ - the new bottom margin in units of @unit@
 -> Unit -- ^ @unit@ - the units for @margin@
 -> IO ()
pageSetupSetBottomMargin :: forall self. PageSetupClass self => self -> Double -> Unit -> IO ()
pageSetupSetBottomMargin self
self Double
margin Unit
unit =
  (\(PageSetup ForeignPtr PageSetup
arg1) CDouble
arg2 CInt
arg3 -> ForeignPtr PageSetup -> (Ptr PageSetup -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO ()) -> IO ())
-> (Ptr PageSetup -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->Ptr PageSetup -> CDouble -> CInt -> IO ()
gtk_page_setup_set_bottom_margin Ptr PageSetup
argPtr1 CDouble
arg2 CInt
arg3)
{-# LINE 230 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
margin)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Unit -> Int) -> Unit -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> Int
forall a. Enum a => a -> Int
fromEnum) Unit
unit)

-- | Gets the left margin in units of @unit@.
--
pageSetupGetLeftMargin :: PageSetupClass self => self
 -> Unit -- ^ @unit@ - the unit for the return value
 -> IO Double -- ^ returns the left margin
pageSetupGetLeftMargin :: forall self. PageSetupClass self => self -> Unit -> IO Double
pageSetupGetLeftMargin self
self Unit
unit =
  (CDouble -> Double) -> IO CDouble -> IO Double
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (IO CDouble -> IO Double) -> IO CDouble -> IO Double
forall a b. (a -> b) -> a -> b
$
  (\(PageSetup ForeignPtr PageSetup
arg1) CInt
arg2 -> ForeignPtr PageSetup -> (Ptr PageSetup -> IO CDouble) -> IO CDouble
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO CDouble) -> IO CDouble)
-> (Ptr PageSetup -> IO CDouble) -> IO CDouble
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->Ptr PageSetup -> CInt -> IO CDouble
gtk_page_setup_get_left_margin Ptr PageSetup
argPtr1 CInt
arg2)
{-# LINE 242 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Unit -> Int) -> Unit -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> Int
forall a. Enum a => a -> Int
fromEnum) Unit
unit)

-- | Sets the left margin of the 'PageSetup'.
--
pageSetupSetLeftMargin :: PageSetupClass self => self
 -> Double -- ^ @margin@ - the new left margin in units of @unit@
 -> Unit -- ^ @unit@ - the units for @margin@
 -> IO ()
pageSetupSetLeftMargin :: forall self. PageSetupClass self => self -> Double -> Unit -> IO ()
pageSetupSetLeftMargin self
self Double
margin Unit
unit =
  (\(PageSetup ForeignPtr PageSetup
arg1) CDouble
arg2 CInt
arg3 -> ForeignPtr PageSetup -> (Ptr PageSetup -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO ()) -> IO ())
-> (Ptr PageSetup -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->Ptr PageSetup -> CDouble -> CInt -> IO ()
gtk_page_setup_set_left_margin Ptr PageSetup
argPtr1 CDouble
arg2 CInt
arg3)
{-# LINE 253 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
margin)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Unit -> Int) -> Unit -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> Int
forall a. Enum a => a -> Int
fromEnum) Unit
unit)

-- | Gets the right margin in units of @unit@.
--
pageSetupGetRightMargin :: PageSetupClass self => self
 -> Unit -- ^ @unit@ - the unit for the return value
 -> IO Double -- ^ returns the right margin
pageSetupGetRightMargin :: forall self. PageSetupClass self => self -> Unit -> IO Double
pageSetupGetRightMargin self
self Unit
unit =
  (CDouble -> Double) -> IO CDouble -> IO Double
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (IO CDouble -> IO Double) -> IO CDouble -> IO Double
forall a b. (a -> b) -> a -> b
$
  (\(PageSetup ForeignPtr PageSetup
arg1) CInt
arg2 -> ForeignPtr PageSetup -> (Ptr PageSetup -> IO CDouble) -> IO CDouble
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO CDouble) -> IO CDouble)
-> (Ptr PageSetup -> IO CDouble) -> IO CDouble
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->Ptr PageSetup -> CInt -> IO CDouble
gtk_page_setup_get_right_margin Ptr PageSetup
argPtr1 CInt
arg2)
{-# LINE 265 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Unit -> Int) -> Unit -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> Int
forall a. Enum a => a -> Int
fromEnum) Unit
unit)

-- | Sets the right margin of the 'PageSetup'.
--
pageSetupSetRightMargin :: PageSetupClass self => self
 -> Double -- ^ @margin@ - the new right margin in units of @unit@
 -> Unit -- ^ @unit@ - the units for @margin@
 -> IO ()
pageSetupSetRightMargin :: forall self. PageSetupClass self => self -> Double -> Unit -> IO ()
pageSetupSetRightMargin self
self Double
margin Unit
unit =
  (\(PageSetup ForeignPtr PageSetup
arg1) CDouble
arg2 CInt
arg3 -> ForeignPtr PageSetup -> (Ptr PageSetup -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO ()) -> IO ())
-> (Ptr PageSetup -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->Ptr PageSetup -> CDouble -> CInt -> IO ()
gtk_page_setup_set_right_margin Ptr PageSetup
argPtr1 CDouble
arg2 CInt
arg3)
{-# LINE 276 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
margin)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Unit -> Int) -> Unit -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> Int
forall a. Enum a => a -> Int
fromEnum) Unit
unit)

-- | Sets the paper size of the 'PageSetup' and modifies the margins according
-- to the new paper size.
--
pageSetupSetPaperSizeAndDefaultMargins :: PageSetupClass self => self
 -> PaperSize -- ^ @size@ - a 'PaperSize'
 -> IO ()
pageSetupSetPaperSizeAndDefaultMargins :: forall self. PageSetupClass self => self -> PaperSize -> IO ()
pageSetupSetPaperSizeAndDefaultMargins self
self PaperSize
size =
  (\(PageSetup ForeignPtr PageSetup
arg1) (PaperSize ForeignPtr PaperSize
arg2) -> ForeignPtr PageSetup -> (Ptr PageSetup -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO ()) -> IO ())
-> (Ptr PageSetup -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->ForeignPtr PaperSize -> (Ptr PaperSize -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PaperSize
arg2 ((Ptr PaperSize -> IO ()) -> IO ())
-> (Ptr PaperSize -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PaperSize
argPtr2 ->Ptr PageSetup -> Ptr PaperSize -> IO ()
gtk_page_setup_set_paper_size_and_default_margins Ptr PageSetup
argPtr1 Ptr PaperSize
argPtr2)
{-# LINE 288 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)
    PaperSize
size

-- | Returns the paper width in units of @unit@.
--
-- Note that this function takes orientation, but not margins into
-- consideration. See 'pageSetupGetPageWidth'.
--
pageSetupGetPaperWidth :: PageSetupClass self => self
 -> Unit -- ^ @unit@ - the unit for the return value
 -> IO Double -- ^ returns the paper width.
pageSetupGetPaperWidth :: forall self. PageSetupClass self => self -> Unit -> IO Double
pageSetupGetPaperWidth self
self Unit
unit =
  (CDouble -> Double) -> IO CDouble -> IO Double
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (IO CDouble -> IO Double) -> IO CDouble -> IO Double
forall a b. (a -> b) -> a -> b
$
  (\(PageSetup ForeignPtr PageSetup
arg1) CInt
arg2 -> ForeignPtr PageSetup -> (Ptr PageSetup -> IO CDouble) -> IO CDouble
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO CDouble) -> IO CDouble)
-> (Ptr PageSetup -> IO CDouble) -> IO CDouble
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->Ptr PageSetup -> CInt -> IO CDouble
gtk_page_setup_get_paper_width Ptr PageSetup
argPtr1 CInt
arg2)
{-# LINE 302 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Unit -> Int) -> Unit -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> Int
forall a. Enum a => a -> Int
fromEnum) Unit
unit)

-- | Returns the paper height in units of @unit@.
--
-- Note that this function takes orientation, but not margins into
-- consideration. See 'pageSetupGetPageHeight'.
--
pageSetupGetPaperHeight :: PageSetupClass self => self
 -> Unit -- ^ @unit@ - the unit for the return value
 -> IO Double -- ^ returns the paper height.
pageSetupGetPaperHeight :: forall self. PageSetupClass self => self -> Unit -> IO Double
pageSetupGetPaperHeight self
self Unit
unit =
  (CDouble -> Double) -> IO CDouble -> IO Double
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (IO CDouble -> IO Double) -> IO CDouble -> IO Double
forall a b. (a -> b) -> a -> b
$
  (\(PageSetup ForeignPtr PageSetup
arg1) CInt
arg2 -> ForeignPtr PageSetup -> (Ptr PageSetup -> IO CDouble) -> IO CDouble
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO CDouble) -> IO CDouble)
-> (Ptr PageSetup -> IO CDouble) -> IO CDouble
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->Ptr PageSetup -> CInt -> IO CDouble
gtk_page_setup_get_paper_height Ptr PageSetup
argPtr1 CInt
arg2)
{-# LINE 316 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Unit -> Int) -> Unit -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> Int
forall a. Enum a => a -> Int
fromEnum) Unit
unit)

-- | Returns the page width in units of @unit@.
--
-- Note that this function takes orientation and margins into consideration.
-- See 'pageSetupGetPaperWidth'.
--
pageSetupGetPageWidth :: PageSetupClass self => self
 -> Unit -- ^ @unit@ - the unit for the return value
 -> IO Double -- ^ returns the page width.
pageSetupGetPageWidth :: forall self. PageSetupClass self => self -> Unit -> IO Double
pageSetupGetPageWidth self
self Unit
unit =
  (CDouble -> Double) -> IO CDouble -> IO Double
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (IO CDouble -> IO Double) -> IO CDouble -> IO Double
forall a b. (a -> b) -> a -> b
$
  (\(PageSetup ForeignPtr PageSetup
arg1) CInt
arg2 -> ForeignPtr PageSetup -> (Ptr PageSetup -> IO CDouble) -> IO CDouble
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO CDouble) -> IO CDouble)
-> (Ptr PageSetup -> IO CDouble) -> IO CDouble
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->Ptr PageSetup -> CInt -> IO CDouble
gtk_page_setup_get_page_width Ptr PageSetup
argPtr1 CInt
arg2)
{-# LINE 330 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Unit -> Int) -> Unit -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> Int
forall a. Enum a => a -> Int
fromEnum) Unit
unit)

-- | Returns the page height in units of @unit@.
--
-- Note that this function takes orientation and margins into consideration.
-- See 'pageSetupGetPaperHeight'.
--
pageSetupGetPageHeight :: PageSetupClass self => self
 -> Unit -- ^ @unit@ - the unit for the return value
 -> IO Double -- ^ returns the page height.
pageSetupGetPageHeight :: forall self. PageSetupClass self => self -> Unit -> IO Double
pageSetupGetPageHeight self
self Unit
unit =
  (CDouble -> Double) -> IO CDouble -> IO Double
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (IO CDouble -> IO Double) -> IO CDouble -> IO Double
forall a b. (a -> b) -> a -> b
$
  (\(PageSetup ForeignPtr PageSetup
arg1) CInt
arg2 -> ForeignPtr PageSetup -> (Ptr PageSetup -> IO CDouble) -> IO CDouble
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO CDouble) -> IO CDouble)
-> (Ptr PageSetup -> IO CDouble) -> IO CDouble
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->Ptr PageSetup -> CInt -> IO CDouble
gtk_page_setup_get_page_height Ptr PageSetup
argPtr1 CInt
arg2)
{-# LINE 344 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Unit -> Int) -> Unit -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> Int
forall a. Enum a => a -> Int
fromEnum) Unit
unit)


-- | Reads the page setup from the file @fileName@. See 'pageSetupToFile'.
--
-- * Available since Gtk+ version 2.14
--
pageSetupLoadFile :: (PageSetupClass self, GlibString string) => self
 -> string -- ^ @fileName@ - the filename to read the page setup from
 -> IO Bool -- ^ returns @True@ on success
pageSetupLoadFile :: forall self string.
(PageSetupClass self, GlibString string) =>
self -> string -> IO Bool
pageSetupLoadFile self
self 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 ())
errorPtr ->
  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 ->
  (\(PageSetup ForeignPtr PageSetup
arg1) CString
arg2 Ptr (Ptr ())
arg3 -> ForeignPtr PageSetup -> (Ptr PageSetup -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO CInt) -> IO CInt)
-> (Ptr PageSetup -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->Ptr PageSetup -> CString -> Ptr (Ptr ()) -> IO CInt
gtk_page_setup_load_file Ptr PageSetup
argPtr1 CString
arg2 Ptr (Ptr ())
arg3)
{-# LINE 360 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)
    CString
fileNamePtr
    Ptr (Ptr ())
errorPtr




-- | This function saves the information from @setup@ to @fileName@.
--
-- * Available since Gtk+ version 2.12
--
pageSetupToFile :: (PageSetupClass self, GlibString string) => self
 -> string -- ^ @fileName@ - the file to save to
 -> IO Bool -- ^ returns @True@ on success
pageSetupToFile :: forall self string.
(PageSetupClass self, GlibString string) =>
self -> string -> IO Bool
pageSetupToFile self
self 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 ())
errorPtr ->
  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 ->
  (\(PageSetup ForeignPtr PageSetup
arg1) CString
arg2 Ptr (Ptr ())
arg3 -> ForeignPtr PageSetup -> (Ptr PageSetup -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PageSetup
arg1 ((Ptr PageSetup -> IO CInt) -> IO CInt)
-> (Ptr PageSetup -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr PageSetup
argPtr1 ->Ptr PageSetup -> CString -> Ptr (Ptr ()) -> IO CInt
gtk_page_setup_to_file Ptr PageSetup
argPtr1 CString
arg2 Ptr (Ptr ())
arg3)
{-# LINE 379 "./Graphics/UI/Gtk/Printing/PageSetup.chs" #-}
    (toPageSetup self)
    CString
fileNamePtr
    Ptr (Ptr ())
errorPtr


-- | The page orientation of the 'PageSetup'.
pageSetupOrientation :: PageSetupClass self => Attr self PageOrientation
pageSetupOrientation :: forall self. PageSetupClass self => Attr self PageOrientation
pageSetupOrientation = (self -> IO PageOrientation)
-> (self -> PageOrientation -> IO ())
-> ReadWriteAttr self PageOrientation PageOrientation
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO PageOrientation
forall self. PageSetupClass self => self -> IO PageOrientation
pageSetupGetOrientation
  self -> PageOrientation -> IO ()
forall self.
PageSetupClass self =>
self -> PageOrientation -> IO ()
pageSetupSetOrientation

-- | The paper size of the 'PageSetup'.
pageSetupPaperSize :: PageSetupClass self => Attr self PaperSize
pageSetupPaperSize :: forall self. PageSetupClass self => Attr self PaperSize
pageSetupPaperSize = (self -> IO PaperSize)
-> (self -> PaperSize -> IO ())
-> ReadWriteAttr self PaperSize PaperSize
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO PaperSize
forall self. PageSetupClass self => self -> IO PaperSize
pageSetupGetPaperSize
  self -> PaperSize -> IO ()
forall self. PageSetupClass self => self -> PaperSize -> IO ()
pageSetupSetPaperSize

foreign import ccall safe "gtk_page_setup_new"
  gtk_page_setup_new :: (IO (Ptr PageSetup))

foreign import ccall safe "gtk_page_setup_new_from_file"
  gtk_page_setup_new_from_file :: ((Ptr CChar) -> ((Ptr (Ptr ())) -> (IO (Ptr PageSetup))))

foreign import ccall safe "gtk_page_setup_copy"
  gtk_page_setup_copy :: ((Ptr PageSetup) -> (IO (Ptr PageSetup)))

foreign import ccall safe "gtk_page_setup_get_orientation"
  gtk_page_setup_get_orientation :: ((Ptr PageSetup) -> (IO CInt))

foreign import ccall safe "gtk_page_setup_set_orientation"
  gtk_page_setup_set_orientation :: ((Ptr PageSetup) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_page_setup_get_paper_size"
  gtk_page_setup_get_paper_size :: ((Ptr PageSetup) -> (IO (Ptr PaperSize)))

foreign import ccall safe "gtk_page_setup_set_paper_size"
  gtk_page_setup_set_paper_size :: ((Ptr PageSetup) -> ((Ptr PaperSize) -> (IO ())))

foreign import ccall safe "gtk_page_setup_get_top_margin"
  gtk_page_setup_get_top_margin :: ((Ptr PageSetup) -> (CInt -> (IO CDouble)))

foreign import ccall safe "gtk_page_setup_set_top_margin"
  gtk_page_setup_set_top_margin :: ((Ptr PageSetup) -> (CDouble -> (CInt -> (IO ()))))

foreign import ccall safe "gtk_page_setup_get_bottom_margin"
  gtk_page_setup_get_bottom_margin :: ((Ptr PageSetup) -> (CInt -> (IO CDouble)))

foreign import ccall safe "gtk_page_setup_set_bottom_margin"
  gtk_page_setup_set_bottom_margin :: ((Ptr PageSetup) -> (CDouble -> (CInt -> (IO ()))))

foreign import ccall safe "gtk_page_setup_get_left_margin"
  gtk_page_setup_get_left_margin :: ((Ptr PageSetup) -> (CInt -> (IO CDouble)))

foreign import ccall safe "gtk_page_setup_set_left_margin"
  gtk_page_setup_set_left_margin :: ((Ptr PageSetup) -> (CDouble -> (CInt -> (IO ()))))

foreign import ccall safe "gtk_page_setup_get_right_margin"
  gtk_page_setup_get_right_margin :: ((Ptr PageSetup) -> (CInt -> (IO CDouble)))

foreign import ccall safe "gtk_page_setup_set_right_margin"
  gtk_page_setup_set_right_margin :: ((Ptr PageSetup) -> (CDouble -> (CInt -> (IO ()))))

foreign import ccall safe "gtk_page_setup_set_paper_size_and_default_margins"
  gtk_page_setup_set_paper_size_and_default_margins :: ((Ptr PageSetup) -> ((Ptr PaperSize) -> (IO ())))

foreign import ccall safe "gtk_page_setup_get_paper_width"
  gtk_page_setup_get_paper_width :: ((Ptr PageSetup) -> (CInt -> (IO CDouble)))

foreign import ccall safe "gtk_page_setup_get_paper_height"
  gtk_page_setup_get_paper_height :: ((Ptr PageSetup) -> (CInt -> (IO CDouble)))

foreign import ccall safe "gtk_page_setup_get_page_width"
  gtk_page_setup_get_page_width :: ((Ptr PageSetup) -> (CInt -> (IO CDouble)))

foreign import ccall safe "gtk_page_setup_get_page_height"
  gtk_page_setup_get_page_height :: ((Ptr PageSetup) -> (CInt -> (IO CDouble)))

foreign import ccall safe "gtk_page_setup_load_file"
  gtk_page_setup_load_file :: ((Ptr PageSetup) -> ((Ptr CChar) -> ((Ptr (Ptr ())) -> (IO CInt))))

foreign import ccall safe "gtk_page_setup_to_file"
  gtk_page_setup_to_file :: ((Ptr PageSetup) -> ((Ptr CChar) -> ((Ptr (Ptr ())) -> (IO CInt))))