{-# LANGUAGE DeriveDataTypeable #-}

{-# LINE 2 "./Graphics/UI/Gtk/Poppler/Document.chs" #-}
-- GIMP Toolkit (GTK) Binding for Haskell: binding to poppler -*-haskell-*-
--
-- Author : Andy Stewart
-- Created: 18-Jun-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 3 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.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this program. If not, see
-- <http:
--
-- POPPLER, the C library which this Haskell library depends on, is
-- available under LGPL Version 2. The documentation included with
-- this library is based on the original POPPLER documentation.
--
-- TODO :
-- poppler_font_info_scan
--
-- | Maintainer : gtk2hs-devel@lists.sourceforge.net
-- Stability : alpha
-- Portability : portable (depends on GHC)
module Graphics.UI.Gtk.Poppler.Document (
-- * Details
--
-- | The 'Document' is an object used to refer to a main document.

-- * Types
    Document,
    DocumentClass,
    Page,
    PageClass,
    IndexIter,
    IndexIterClass,
    FontsIter,
    FontsIterClass,
    FontInfo,
    FontInfoClass,
    Dest,
    DestClass,
    FormField,
    Action,
    PSFile,
    PSFileClass,

-- * Enums
    FontType (..),
    PageLayout (..),
    PageMode (..),
    Permissions (..),
    ViewerPreferences (..),

-- * Methods
    documentNewFromFile,
    documentNewFromData,
    documentSave,
    documentGetNPages,
    documentGetPage,
    documentGetPageByLabel,
    documentFindDest,
    documentHasAttachments,
    documentGetAttachments,
    documentGetFormField,

    indexIterNew,
    indexIterCopy,
    indexIterGetChild,
    indexIterIsOpen,
    indexIterNext,
    indexIterGetAction,

    fontInfoNew,
    fontsIterCopy,
    fontsIterGetName,
    fontsIterGetFullName,
    fontsIterGetFontType,
    fontsIterIsEmbedded,
    fontsIterIsSubset,
    fontsIterNext,

    psFileNew,
    psFileSetPaperSize,
    psFileSetDuplex,

-- * Attributes
    documentAuthor,
    documentCreationDate,
    documentCreator,
    documentFormat,
    documentFormatMajor,
    documentFormatMinor,
    documentKeywords,
    documentLinearized,
    documentMetadata,
    documentModDate,
    documentPageLayout,
    documentPageMode,
    documentPermissions,
    documentProducer,
    documentSubject,
    documentTitle,
    documentViewerPreferences,
    documentLabel,
    ) where

import Control.Monad
import Data.Typeable
import System.Glib.Attributes
import System.Glib.Properties
import System.Glib.FFI
import System.Glib.Flags
import System.Glib.GList
import System.Glib.GError
import System.Glib.GObject
import System.Glib.UTFString
import Graphics.UI.Gtk.Poppler.Enums
import Graphics.UI.Gtk.Poppler.Types
{-# LINE 128 "./Graphics/UI/Gtk/Poppler/Document.chs" #-}


{-# LINE 130 "./Graphics/UI/Gtk/Poppler/Document.chs" #-}

-- | Creates a new 'Document'. If 'Nothing' is returned, then error will be set. Possible errors include
-- those in the 'Error' and GFileError domains.
documentNewFromFile ::
    String -- ^ @uri@ uri of the file to load
 -> Maybe String -- ^ @password@ password to unlock the file with, or 'Nothing'
 -> IO (Maybe Document) -- ^ returns A newly created 'Document', or 'Nothing'
documentNewFromFile uri password =
  maybeNull (makeNewGObject mkDocument) $
  withUTFString uri $ \ uriPtr ->
  maybeWith withUTFString password $ \ passwordPtr ->
      propagateGError (poppler_document_new_from_file
{-# LINE 142 "./Graphics/UI/Gtk/Poppler/Document.chs" #-}
                       uriPtr
                       passwordPtr)

-- | Creates a new 'Document'. If 'Nothing' is returned, then error will be set. Possible errors include
-- those in the 'Error' and GFileError domains.
documentNewFromData ::
   String -- ^ @data@ the pdf data contained in a char array
 -> Maybe String -- ^ @password@ password to unlock the file with, or 'Nothing'
 -> IO (Maybe Document) -- ^ returns A newly created 'Document', or 'Nothing'
documentNewFromData dat password =
  maybeNull (makeNewGObject mkDocument) $
  withUTFString dat $ \ datPtr ->
  maybeWith withUTFString password $ \ passwordPtr ->
      propagateGError (poppler_document_new_from_data
{-# LINE 156 "./Graphics/UI/Gtk/Poppler/Document.chs" #-}
                       datPtr
                       (fromIntegral (length dat))
                       passwordPtr)

-- | Saves document. Any change made in the document such as form fields filled by the user will be
-- saved. If error is set, 'False' will be returned. Possible errors include those in the GFileError
-- domain.
documentSave :: DocumentClass doc => doc
 -> String -- ^ @uri@ uri of file to save
 -> IO Bool -- ^ returns 'True', if the document was successfully saved
documentSave doc uri =
  liftM toBool $
  withUTFString uri $ \ uriPtr ->
      propagateGError ((\(Document arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->poppler_document_save argPtr1 arg2 arg3)
{-# LINE 170 "./Graphics/UI/Gtk/Poppler/Document.chs" #-}
                       (toDocument doc)
                       uriPtr)

-- | Returns the number of pages in a loaded document.
documentGetNPages :: DocumentClass doc => doc
 -> IO Int -- ^ returns Number of pages
documentGetNPages doc =
  liftM fromIntegral $
  (\(Document arg1) -> withForeignPtr arg1 $ \argPtr1 ->poppler_document_get_n_pages argPtr1) (toDocument doc)

-- | Returns the 'Page' indexed at index. This object is owned by the caller.
-- | 'Page's are indexed starting at 0.
documentGetPage :: DocumentClass doc => doc
 -> Int -- ^ @index@ a page index
 -> IO Page -- ^ returns The 'Page' at index
documentGetPage doc index =
  makeNewGObject mkPage $
  (\(Document arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->poppler_document_get_page argPtr1 arg2) (toDocument doc) (fromIntegral index)

-- | Returns the 'Page' reference by label. This object is owned by the caller. label is a
-- human-readable string representation of the page number, and can be document specific. Typically, it
-- is a value such as "iii" or "3".
--
-- By default, "1" refers to the first page.
documentGetPageByLabel :: DocumentClass doc => doc
 -> String -- ^ @label@ a page label
 -> IO Page -- ^ returns The 'Page' referenced by label
documentGetPageByLabel doc label =
  makeNewGObject mkPage $
  withUTFString label $ \ labelPtr ->
  (\(Document arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->poppler_document_get_page_by_label argPtr1 arg2) (toDocument doc) labelPtr

-- | Finds named destination @linkName@ in document
documentFindDest :: DocumentClass doc => doc
 -> String -- ^ @linkName@ a named destination
 -> IO (Maybe Dest) -- ^ returns The 'Dest' destination or 'Nothing' if @linkName@ is not a destination.
documentFindDest doc linkName =
  withUTFString linkName $ \ linkNamePtr -> do
      destPtr <- (\(Document arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->poppler_document_find_dest argPtr1 arg2)
{-# LINE 209 "./Graphics/UI/Gtk/Poppler/Document.chs" #-}
                  (toDocument doc)
                  linkNamePtr
      if destPtr == nullPtr
         then return Nothing
         else do
           dest <- makeNewGObject mkDest $ return destPtr
           (\(Dest arg1) -> withForeignPtr arg1 $ \argPtr1 ->poppler_dest_free argPtr1) dest
           return $ Just dest

-- | Returns 'True' of document has any attachments.
documentHasAttachments :: DocumentClass doc => doc
 -> IO Bool -- ^ returns 'True', if document has attachments.
documentHasAttachments doc =
  liftM toBool $
  (\(Document arg1) -> withForeignPtr arg1 $ \argPtr1 ->poppler_document_has_attachments argPtr1) (toDocument doc)

-- | Returns the 'FormField' for the given id.
documentGetFormField :: DocumentClass doc => doc
 -> Int -- ^ @id@ an id of a 'FormField'
 -> IO (Maybe FormField)
documentGetFormField doc id =
  maybeNull (makeNewGObject mkFormField) $
  (\(Document arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->poppler_document_get_form_field argPtr1 arg2)
{-# LINE 232 "./Graphics/UI/Gtk/Poppler/Document.chs" #-}
    (toDocument doc)
    (fromIntegral id)

-- | Create a new postscript file to render to
psFileNew :: DocumentClass doc => doc
 -> String -- ^ @filename@ the path of the output filename
 -> Int -- ^ @firstPage@ the first page to print
 -> Int -- ^ @nPages@ the number of pages to print
 -> IO PSFile
psFileNew doc filename firstPage nPages =
  makeNewGObject mkPSFile $
  withUTFString filename $ \ filenamePtr ->
  (\(Document arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->poppler_ps_file_new argPtr1 arg2 arg3 arg4)
{-# LINE 245 "./Graphics/UI/Gtk/Poppler/Document.chs" #-}
    (toDocument doc)
    filenamePtr
    (fromIntegral firstPage)
    (fromIntegral nPages)

-- | Set the output paper size. These values will end up in the DocumentMedia, the BoundingBox DSC
-- comments and other places in the generated PostScript.
psFileSetPaperSize :: PSFileClass file =>
 file -- ^ @psFile@ a 'PSFile' which was not yet printed to.
 -> Double -- ^ @width@ the paper width in 1/72 inch
 -> Double -- ^ @height@ the paper height in 1/72 inch
 -> IO ()
psFileSetPaperSize psFile width height =
  (\(PSFile arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->poppler_ps_file_set_paper_size argPtr1 arg2 arg3)
{-# LINE 259 "./Graphics/UI/Gtk/Poppler/Document.chs" #-}
    (toPSFile psFile)
    (realToFrac width)
    (realToFrac height)

-- | Enable or disable Duplex printing.
psFileSetDuplex :: PSFileClass file =>
  file -- ^ @psFile@ a 'PSFile' which was not yet printed to
 -> Bool -- ^ @duplex@ whether to force duplex printing (on printers which support this)
 -> IO ()
psFileSetDuplex psFile duplex =
  (\(PSFile arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->poppler_ps_file_set_duplex argPtr1 arg2)
{-# LINE 270 "./Graphics/UI/Gtk/Poppler/Document.chs" #-}
    (toPSFile psFile)
    (fromBool duplex)

-- | Returns a GList containing 'Attachment's.
documentGetAttachments :: DocumentClass doc => doc
 -> IO [Attachment]
documentGetAttachments doc = do
  glistPtr <- (\(Document arg1) -> withForeignPtr arg1 $ \argPtr1 ->poppler_document_get_attachments argPtr1) (toDocument doc)
  list <- fromGList glistPtr
  attachs <- mapM (makeNewGObject mkAttachment . return) list
  g_list_free glistPtr
  return attachs

-- | Returns the root 'IndexIter' for document, or 'Nothing'.
indexIterNew :: DocumentClass doc => doc -> IO (Maybe IndexIter)
indexIterNew doc =
  maybeNull (makeNewGObject mkIndexIter) $
  (\(Document arg1) -> withForeignPtr arg1 $ \argPtr1 ->poppler_index_iter_new argPtr1) (toDocument doc)

-- | Creates a new 'IndexIter' as a copy of iter.
indexIterCopy :: IndexIterClass iter => iter -> IO IndexIter
indexIterCopy iter =
  makeNewGObject mkIndexIter $
  (\(IndexIter arg1) -> withForeignPtr arg1 $ \argPtr1 ->poppler_index_iter_copy argPtr1) (toIndexIter iter)

-- | Returns a newly created child of parent, or 'Nothing' if the iter has no child. See
-- 'indexIterNew' for more information on this function.
indexIterGetChild :: IndexIterClass iter => iter -> IO (Maybe IndexIter)
indexIterGetChild iter =
  maybeNull (makeNewGObject mkIndexIter) $
  (\(IndexIter arg1) -> withForeignPtr arg1 $ \argPtr1 ->poppler_index_iter_get_child argPtr1) (toIndexIter iter)

-- | Returns whether this node should be expanded by default to the user. The document can provide a hint
-- as to how the document's index should be expanded initially.
indexIterIsOpen :: IndexIterClass iter => iter
 -> IO Bool -- ^ returns 'True', if the document wants iter to be expanded
indexIterIsOpen iter =
  liftM toBool $
  (\(IndexIter arg1) -> withForeignPtr arg1 $ \argPtr1 ->poppler_index_iter_is_open argPtr1) (toIndexIter iter)

-- | Sets iter to point to the next action at the current level, if valid. See 'indexIterNew'
-- for more information.
indexIterNext :: IndexIterClass iter => iter
 -> IO Bool -- ^ returns 'True', if iter was set to the next action
indexIterNext iter =
  liftM toBool $
  (\(IndexIter arg1) -> withForeignPtr arg1 $ \argPtr1 ->poppler_index_iter_next argPtr1) (toIndexIter iter)

-- | Returns the 'Action' associated with iter.
indexIterGetAction :: IndexIterClass iter => iter -> IO Action
indexIterGetAction iter =
  makeNewGObject mkAction $
  (\(IndexIter arg1) -> withForeignPtr arg1 $ \argPtr1 ->poppler_index_iter_get_action argPtr1) (toIndexIter iter)

-- |
fontInfoNew :: DocumentClass doc => doc -> IO FontInfo
fontInfoNew doc =
  makeNewGObject mkFontInfo $
  (\(Document arg1) -> withForeignPtr arg1 $ \argPtr1 ->poppler_font_info_new argPtr1) (toDocument doc)

-- |
fontsIterCopy :: FontsIterClass iter => iter -> IO FontsIter
fontsIterCopy iter =
  makeNewGObject mkFontsIter $
  (\(FontsIter arg1) -> withForeignPtr arg1 $ \argPtr1 ->poppler_fonts_iter_copy argPtr1) (toFontsIter iter)

-- |
fontsIterGetName :: FontsIterClass iter => iter -> IO String
fontsIterGetName iter =
  (\(FontsIter arg1) -> withForeignPtr arg1 $ \argPtr1 ->poppler_fonts_iter_get_name argPtr1) (toFontsIter iter)
  >>= peekUTFString

-- |
fontsIterGetFullName :: FontsIterClass iter => iter -> IO String
fontsIterGetFullName iter =
  (\(FontsIter arg1) -> withForeignPtr arg1 $ \argPtr1 ->poppler_fonts_iter_get_full_name argPtr1) (toFontsIter iter)
  >>= peekUTFString

-- |
fontsIterGetFontType :: FontsIterClass iter => iter -> IO FontType
fontsIterGetFontType iter =
  liftM (toEnum . fromIntegral) $
  (\(FontsIter arg1) -> withForeignPtr arg1 $ \argPtr1 ->poppler_fonts_iter_get_font_type argPtr1) (toFontsIter iter)

-- |
fontsIterIsEmbedded :: FontsIterClass iter => iter
 -> IO Bool
fontsIterIsEmbedded iter =
  liftM toBool $
  (\(FontsIter arg1) -> withForeignPtr arg1 $ \argPtr1 ->poppler_fonts_iter_is_embedded argPtr1) (toFontsIter iter)

-- |
fontsIterIsSubset :: FontsIterClass iter => iter
 -> IO Bool
fontsIterIsSubset iter =
  liftM toBool $
  (\(FontsIter arg1) -> withForeignPtr arg1 $ \argPtr1 ->poppler_fonts_iter_is_subset argPtr1) (toFontsIter iter)

-- |
fontsIterNext :: FontsIterClass iter => iter
 -> IO Bool -- ^ returns 'True', if iter was set to the next action
fontsIterNext iter =
  liftM toBool $
  (\(FontsIter arg1) -> withForeignPtr arg1 $ \argPtr1 ->poppler_fonts_iter_next argPtr1) (toFontsIter iter)

-------------------
-- Attributes
-- | The author of the document.
--
-- Default value: \"\"
documentAuthor :: DocumentClass doc => ReadAttr doc String
documentAuthor = readAttrFromStringProperty "author"

-- | The date and time the document was created.
--
-- Allowed values: >= 0
--
-- Default value: 0
documentCreationDate :: DocumentClass doc => ReadAttr doc Int
documentCreationDate = readAttrFromIntProperty "creation-date"

-- | The software that created the document.
--
-- Default value: \"\"
documentCreator :: DocumentClass doc => ReadAttr doc String
documentCreator = readAttrFromStringProperty "creator"

-- | The PDF version of the document.
--
-- Default value: \"\"
documentFormat :: DocumentClass doc => ReadAttr doc String
documentFormat = readAttrFromStringProperty "format"

-- | The PDF major version number of the document.
--
-- Default value: 1
documentFormatMajor :: DocumentClass doc => ReadAttr doc String
documentFormatMajor = readAttrFromStringProperty "format-major"

-- | The PDF minor version number of the document.
--
-- Default value: 0
documentFormatMinor :: DocumentClass doc => ReadAttr doc String
documentFormatMinor = readAttrFromStringProperty "format-minor"

-- | Keywords.
--
-- Default value: \"\"
documentKeywords :: DocumentClass doc => ReadAttr doc String
documentKeywords = readAttrFromStringProperty "keywords"

-- | Is the document optimized for web viewing?.
--
-- Default value: \"\"
documentLinearized :: DocumentClass doc => ReadAttr doc String
documentLinearized = readAttrFromStringProperty "linearized"

-- | Embedded XML metadata.
--
-- Default value: \"\"
documentMetadata :: DocumentClass doc => ReadAttr doc String
documentMetadata = readAttrFromStringProperty "metadata"

-- | The date and time the document was modified.
--
-- Allowed values: >= 0
--
-- Default value: 0
documentModDate :: DocumentClass doc => ReadAttr doc Int
documentModDate = readAttrFromIntProperty "mod-date"

-- | Initial Page Layout.
--
-- Default value: 'PageLayoutUnset'
documentPageLayout :: DocumentClass doc => ReadAttr doc PageLayout
documentPageLayout = readAttrFromEnumProperty "page-layout"
                     poppler_page_layout_get_type
{-# LINE 447 "./Graphics/UI/Gtk/Poppler/Document.chs" #-}

-- | Page Mode.
--
-- Default value: 'PageModeUnset'
documentPageMode :: DocumentClass doc => ReadAttr doc PageMode
documentPageMode = readAttrFromEnumProperty "page-mode"
                   poppler_page_mode_get_type
{-# LINE 454 "./Graphics/UI/Gtk/Poppler/Document.chs" #-}

-- | Permissions.
--
-- Default value: 'PermissionsFull'
documentPermissions :: DocumentClass doc => ReadAttr doc Permissions
documentPermissions = readAttrFromEnumProperty "permissions"
                      poppler_permissions_get_type
{-# LINE 461 "./Graphics/UI/Gtk/Poppler/Document.chs" #-}

-- | The software that converted the document.
--
-- Default value: \"\"
documentProducer :: DocumentClass doc => ReadAttr doc String
documentProducer = readAttrFromStringProperty "producer"

-- | Subjects the document touches.
--
-- Default value: \"\"
documentSubject :: DocumentClass doc => ReadAttr doc String
documentSubject = readAttrFromStringProperty "subject"

-- | The title of the document.
--
-- Default value: \"\"
documentTitle :: DocumentClass doc => ReadAttr doc String
documentTitle = readAttrFromStringProperty "title"

-- | Viewer Preferences.
documentViewerPreferences :: DocumentClass doc => ReadAttr doc ViewerPreferences
documentViewerPreferences = readAttrFromEnumProperty "viewer-preferences"
                            poppler_viewer_preferences_get_type
{-# LINE 484 "./Graphics/UI/Gtk/Poppler/Document.chs" #-}

-- | The label of the page.
--
-- Default value: \"\"
documentLabel :: DocumentClass doc => ReadAttr doc String
documentLabel = readAttrFromStringProperty "label"

foreign import ccall safe "poppler_document_new_from_file"
  poppler_document_new_from_file :: ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr (Ptr ())) -> (IO (Ptr Document)))))

foreign import ccall safe "poppler_document_new_from_data"
  poppler_document_new_from_data :: ((Ptr CChar) -> (CInt -> ((Ptr CChar) -> ((Ptr (Ptr ())) -> (IO (Ptr Document))))))

foreign import ccall safe "poppler_document_save"
  poppler_document_save :: ((Ptr Document) -> ((Ptr CChar) -> ((Ptr (Ptr ())) -> (IO CInt))))

foreign import ccall safe "poppler_document_get_n_pages"
  poppler_document_get_n_pages :: ((Ptr Document) -> (IO CInt))

foreign import ccall safe "poppler_document_get_page"
  poppler_document_get_page :: ((Ptr Document) -> (CInt -> (IO (Ptr Page))))

foreign import ccall safe "poppler_document_get_page_by_label"
  poppler_document_get_page_by_label :: ((Ptr Document) -> ((Ptr CChar) -> (IO (Ptr Page))))

foreign import ccall safe "poppler_document_find_dest"
  poppler_document_find_dest :: ((Ptr Document) -> ((Ptr CChar) -> (IO (Ptr Dest))))

foreign import ccall unsafe "poppler_dest_free"
  poppler_dest_free :: ((Ptr Dest) -> (IO ()))

foreign import ccall safe "poppler_document_has_attachments"
  poppler_document_has_attachments :: ((Ptr Document) -> (IO CInt))

foreign import ccall safe "poppler_document_get_form_field"
  poppler_document_get_form_field :: ((Ptr Document) -> (CInt -> (IO (Ptr FormField))))

foreign import ccall safe "poppler_ps_file_new"
  poppler_ps_file_new :: ((Ptr Document) -> ((Ptr CChar) -> (CInt -> (CInt -> (IO (Ptr PSFile))))))

foreign import ccall safe "poppler_ps_file_set_paper_size"
  poppler_ps_file_set_paper_size :: ((Ptr PSFile) -> (CDouble -> (CDouble -> (IO ()))))

foreign import ccall safe "poppler_ps_file_set_duplex"
  poppler_ps_file_set_duplex :: ((Ptr PSFile) -> (CInt -> (IO ())))

foreign import ccall safe "poppler_document_get_attachments"
  poppler_document_get_attachments :: ((Ptr Document) -> (IO (Ptr ())))

foreign import ccall unsafe "g_list_free"
  g_list_free :: ((Ptr ()) -> (IO ()))

foreign import ccall safe "poppler_index_iter_new"
  poppler_index_iter_new :: ((Ptr Document) -> (IO (Ptr IndexIter)))

foreign import ccall safe "poppler_index_iter_copy"
  poppler_index_iter_copy :: ((Ptr IndexIter) -> (IO (Ptr IndexIter)))

foreign import ccall safe "poppler_index_iter_get_child"
  poppler_index_iter_get_child :: ((Ptr IndexIter) -> (IO (Ptr IndexIter)))

foreign import ccall safe "poppler_index_iter_is_open"
  poppler_index_iter_is_open :: ((Ptr IndexIter) -> (IO CInt))

foreign import ccall safe "poppler_index_iter_next"
  poppler_index_iter_next :: ((Ptr IndexIter) -> (IO CInt))

foreign import ccall safe "poppler_index_iter_get_action"
  poppler_index_iter_get_action :: ((Ptr IndexIter) -> (IO (Ptr Action)))

foreign import ccall safe "poppler_font_info_new"
  poppler_font_info_new :: ((Ptr Document) -> (IO (Ptr FontInfo)))

foreign import ccall safe "poppler_fonts_iter_copy"
  poppler_fonts_iter_copy :: ((Ptr FontsIter) -> (IO (Ptr FontsIter)))

foreign import ccall safe "poppler_fonts_iter_get_name"
  poppler_fonts_iter_get_name :: ((Ptr FontsIter) -> (IO (Ptr CChar)))

foreign import ccall safe "poppler_fonts_iter_get_full_name"
  poppler_fonts_iter_get_full_name :: ((Ptr FontsIter) -> (IO (Ptr CChar)))

foreign import ccall safe "poppler_fonts_iter_get_font_type"
  poppler_fonts_iter_get_font_type :: ((Ptr FontsIter) -> (IO CInt))

foreign import ccall safe "poppler_fonts_iter_is_embedded"
  poppler_fonts_iter_is_embedded :: ((Ptr FontsIter) -> (IO CInt))

foreign import ccall safe "poppler_fonts_iter_is_subset"
  poppler_fonts_iter_is_subset :: ((Ptr FontsIter) -> (IO CInt))

foreign import ccall safe "poppler_fonts_iter_next"
  poppler_fonts_iter_next :: ((Ptr FontsIter) -> (IO CInt))

foreign import ccall unsafe "poppler_page_layout_get_type"
  poppler_page_layout_get_type :: CUInt

foreign import ccall unsafe "poppler_page_mode_get_type"
  poppler_page_mode_get_type :: CUInt

foreign import ccall unsafe "poppler_permissions_get_type"
  poppler_permissions_get_type :: CUInt

foreign import ccall unsafe "poppler_viewer_preferences_get_type"
  poppler_viewer_preferences_get_type :: CUInt