gio: S.G.File: specify module exports

gio: S.G.File: specify module exports

--  GIMP Toolkit (GTK) Binding for Haskell: binding to gio -*-haskell-*-
--
--  Author : Peter Gavin
--  Created: 13-Oct-2008
--
--  Copyright (c) 2008 Peter Gavin
--
--  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://www.gnu.org/licenses/>.
--
--  GIO, 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 GIO documentation,
--  Copyright (c) 2001 Seth Nickell <snickell@stanford.edu>. The
--  documentation is covered by the GNU Free Documentation License,
--  version 1.2.
--
-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net
--   Stability   : alpha
--   Portability : portable (depends on GHC)
module System.GIO.File (
    File,
    FileClass,
    FileQueryInfoFlags,
    FileCreateFlags,
    FileCopyFlags,
    FileMonitorFlags,
    FilesystemPreviewType,
    FileProgressCallback,
    FileReadMoreCallback,
    fileNewForPath,
    fileNewForURI,
    fileNewForCommandlineArg,
    fileParseName,
    fileDup,
    fileEqual,
    fileGetBasename,
    fileGetPath,
    fileGetURI,
    fileGetParseName,
    fileGetChild,
    fileGetChildForDisplayName,
    fileHasPrefix,
    fileGetRelativePath,
    fileResolveRelativePath,
    fileIsNative,
    fileHasURIScheme,
    fileGetURIScheme,
    fileRead,
    fileReadAsync,
    fileReadFinish,
    fileAppendTo,
    fileCreate,
    fileReplace,
    fileAppendToAsync,
    fileAppendToFinish,
    fileCreateAsync,
    fileCreateFinish,
    fileReplaceAsync,
    fileReplaceFinish,
    fileQueryInfo,
    fileQueryInfoAsync,
    fileQueryExists,
    fileQueryFilesystemInfo
    ) where

import Control.Monad
import qualified Data.ByteString as BS
import Data.Typeable

import System.Glib.FFI
import System.Glib.Flags
import System.Glib.GError
import System.Glib.UTFString

import System.GIO.Base
{#import System.GIO.Types#}

{# context lib = "gio" prefix = "g" #}

{# enum GFileQueryInfoFlags as FileQueryInfoFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileQueryInfoFlags

{# enum GFileCreateFlags as FileCreateFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileCreateFlags

{# enum GFileCopyFlags as FileCopyFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileCopyFlags

{# enum GFileMonitorFlags as FileMonitorFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileMonitorFlags

{# enum GFilesystemPreviewType as FilesystemPreviewType {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}

type FileProgressCallback = {# type goffset #} -> {# type goffset #} -> IO ()
type FileReadMoreCallback = BS.ByteString -> IO Bool

fileNewForPath :: FilePath -> IO File
fileNewForPath path =
    withUTFString path $ {# call file_new_for_path #} >=> takeGObject

fileNewForURI :: String -> IO File
fileNewForURI uri =
    withUTFString uri $ {# call file_new_for_uri #} >=> takeGObject

fileNewForCommandlineArg :: String -> IO File
fileNewForCommandlineArg arg =
    withUTFString arg $ {# call file_new_for_commandline_arg #} >=> takeGObject

fileParseName :: String -> IO File
fileParseName parseName =
    withUTFString parseName $ {# call file_parse_name #} >=> takeGObject

fileDup :: FileClass file
        => file -> IO file
fileDup =
    {# call file_dup #} . toFile >=> takeGObject . castPtr

fileEqual :: (FileClass file1, FileClass file2)
          => file1 -> file2 -> IO Bool
fileEqual file1 file2 =
    liftM toBool $ {# call file_equal #} (toFile file1) (toFile file2)

fileGetBasename :: FileClass file => file -> IO String
fileGetBasename =
    {# call file_get_basename #} . toFile >=> readUTFString

fileGetPath :: FileClass file => file -> IO FilePath
fileGetPath =
    {# call file_get_path #} . toFile >=> readUTFString

fileGetURI :: FileClass file => file -> IO String
fileGetURI =
    {# call file_get_uri #} . toFile >=> readUTFString

fileGetParseName :: FileClass file => file -> IO String
fileGetParseName =
    {# call file_get_parse_name #} . toFile >=> readUTFString

fileGetParent :: FileClass file => file -> IO (Maybe File)
fileGetParent =
    {# call file_get_parent #} . toFile >=> maybePeek takeGObject

fileGetChild :: FileClass file => file -> String -> IO (Maybe File)
fileGetChild file name =
    withUTFString name $ {# call file_get_child #} (toFile file) >=> maybePeek takeGObject

fileGetChildForDisplayName :: FileClass file => file -> String -> IO File
fileGetChildForDisplayName file displayName =
    withUTFString displayName $ \cDisplayName ->
        propagateGError ({# call file_get_child_for_display_name #} (toFile file) cDisplayName) >>=
        takeGObject

fileHasPrefix :: (FileClass file1, FileClass file2) => file1 -> file2 -> IO Bool
fileHasPrefix file1 file2 =
    liftM toBool $ {# call file_has_prefix #} (toFile file1) (toFile file2)

fileGetRelativePath :: (FileClass file1, FileClass file2) => file1 -> file2 -> IO FilePath
fileGetRelativePath file1 file2 =
    {# call file_get_relative_path #} (toFile file1) (toFile file2) >>= readUTFString

fileResolveRelativePath :: FileClass file => file -> FilePath -> IO (Maybe File)
fileResolveRelativePath file relativePath =
    withUTFString relativePath $ \cRelativePath ->
        {# call file_resolve_relative_path #} (toFile file) cRelativePath >>=
        maybePeek takeGObject

fileIsNative :: FileClass file => file -> IO Bool
fileIsNative =
    liftM toBool . {# call file_is_native #} . toFile

fileHasURIScheme :: FileClass file => file -> String -> IO Bool
fileHasURIScheme file uriScheme =
    withUTFString uriScheme $ \cURIScheme ->
        liftM toBool $ {# call file_has_uri_scheme #} (toFile file) cURIScheme

fileGetURIScheme :: FileClass file => file -> IO String
fileGetURIScheme =
    {# call file_get_uri_scheme #} . toFile >=> readUTFString

fileRead :: FileClass file => file -> Maybe Cancellable -> IO FileInputStream
fileRead file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
            propagateGError (g_file_read cFile cCancellable) >>= takeGObject
    where _ = {# call file_read #}

fileReadAsync :: FileClass file
              => file
              -> Int
              -> Maybe Cancellable
              -> AsyncReadyCallback
              -> IO ()
fileReadAsync file ioPriority mbCancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject mbCancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_read_async cFile
                            (fromIntegral ioPriority)
                            cCancellable
                            cCallback
                            (castFunPtrToPtr cCallback)
    where _ = {# call file_read_async #}

fileReadFinish :: FileClass file
               => file
               -> AsyncResult
               -> IO FileInputStream
fileReadFinish file asyncResult =
    propagateGError ({# call file_read_finish #} (toFile file) asyncResult) >>= takeGObject

fileAppendTo :: FileClass file
             => file
             -> [FileCreateFlags]
             -> Maybe Cancellable
             -> IO FileOutputStream
fileAppendTo file flags cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_append_to cFile (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_append_to #}

fileCreate :: FileClass file
           => file
           -> [FileCreateFlags]
           -> Maybe Cancellable
           -> IO FileOutputStream
fileCreate file flags cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_create cFile (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_create #}

fileReplace :: FileClass file
            => file
            -> Maybe String
            -> Bool
            -> [FileCreateFlags]
            -> Maybe Cancellable
            -> IO FileOutputStream
fileReplace file etag makeBackup flags cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withUTFString etag $ \cEtag ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_replace cFile
                                        cEtag
                                        (fromBool makeBackup)
                                        (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_replace #}

fileAppendToAsync :: FileClass file
                  => file
                  -> [FileCreateFlags]
                  -> Int
                  -> Maybe Cancellable
                  -> AsyncReadyCallback
                  -> IO ()
fileAppendToAsync file flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_append_to_async cFile
                                 (cFromFlags flags)
                                 (fromIntegral ioPriority)
                                 cCancellable
                                 cCallback
                                 (castFunPtrToPtr cCallback)
    where _ = {# call file_append_to_async #}

fileAppendToFinish :: FileClass file
                   => file
                   -> AsyncResult
                   -> IO FileOutputStream
fileAppendToFinish file asyncResult =
    propagateGError ({# call file_append_to_finish #} (toFile file) asyncResult) >>= takeGObject

fileCreateAsync :: FileClass file
                  => file
                  -> [FileCreateFlags]
                  -> Int
                  -> Maybe Cancellable
                  -> AsyncReadyCallback
                  -> IO ()
fileCreateAsync file flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_create_async cFile
                              (cFromFlags flags)
                              (fromIntegral ioPriority)
                              cCancellable
                              cCallback
                              (castFunPtrToPtr cCallback)
    where _ = {# call file_create_async #}

fileCreateFinish :: FileClass file
                   => file
                   -> AsyncResult
                   -> IO FileOutputStream
fileCreateFinish file asyncResult =
    propagateGError ({# call file_create_finish #} (toFile file) asyncResult) >>= takeGObject

fileReplaceAsync :: FileClass file
                 => file
                 -> String
                 -> Bool
                 -> [FileCreateFlags]
                 -> Int
                 -> Maybe Cancellable
                 -> AsyncReadyCallback
                 -> IO ()
fileReplaceAsync file etag makeBackup flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString etag $ \cEtag ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_replace_async cFile
                               cEtag
                               (fromBool makeBackup)
                               (cFromFlags flags)
                               (fromIntegral ioPriority)
                               cCancellable
                               cCallback
                               (castFunPtrToPtr cCallback)
    where _ = {# call file_replace_async #}

fileReplaceFinish :: FileClass file
                  => file
                  -> AsyncResult
                  -> IO FileOutputStream
fileReplaceFinish file asyncResult =
    propagateGError ({# call file_replace_finish #} (toFile file) asyncResult) >>= takeGObject

fileQueryInfo :: FileClass file
              => file
              -> String
              -> [FileQueryInfoFlags]
              -> Maybe Cancellable
              -> IO FileInfo
fileQueryInfo file attributes flags cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_query_info cFile cAttributes (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_query_info #}

fileQueryInfoAsync :: FileClass file
                   => file
                   -> String
                   -> [FileQueryInfoFlags]
                   -> Int
                   -> Maybe Cancellable
                   -> AsyncReadyCallback
                   -> IO ()
fileQueryInfoAsync file attributes flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_query_info_async cFile
                                  cAttributes
                                  (cFromFlags flags)
                                  (fromIntegral ioPriority)
                                  cCancellable
                                  cCallback
                                  (castFunPtrToPtr cCallback)
    where _ = {# call file_query_info_async #}

fileQueryExists :: FileClass file
                => file
                -> Maybe Cancellable
                -> IO Bool
fileQueryExists file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
            liftM toBool $ g_file_query_exists cFile cCancellable
    where _ = {# call file_query_exists #}

fileQueryFilesystemInfo :: FileClass file
                        => file
                        -> String
                        -> Maybe Cancellable
                        -> IO FileInfo
fileQueryFilesystemInfo file attributes cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_query_filesystem_info cFile cAttributes cCancellable) >>=
        takeGObject
    where _ = {# call file_query_filesystem_info #}

--  GIMP Toolkit (GTK) Binding for Haskell: binding to gio -*-haskell-*-
--
--  Author : Peter Gavin
--  Created: 13-Oct-2008
--
--  Copyright (c) 2008 Peter Gavin
--
--  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://www.gnu.org/licenses/>.
--
--  GIO, 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 GIO documentation,
--  Copyright (c) 2001 Seth Nickell <snickell@stanford.edu>. The
--  documentation is covered by the GNU Free Documentation License,
--  version 1.2.
--
-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net
--   Stability   : alpha
--   Portability : portable (depends on GHC)
module System.GIO.File where

import Control.Monad
import qualified Data.ByteString as BS
import Data.Typeable

import System.Glib.FFI
import System.Glib.Flags
import System.Glib.GError
import System.Glib.UTFString

import System.GIO.Base
{#import System.GIO.Types#}

{# context lib = "gio" prefix = "g" #}

{# enum GFileQueryInfoFlags as FileQueryInfoFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileQueryInfoFlags

{# enum GFileCreateFlags as FileCreateFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileCreateFlags

{# enum GFileCopyFlags as FileCopyFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileCopyFlags

{# enum GFileMonitorFlags as FileMonitorFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileMonitorFlags

{# enum GFilesystemPreviewType as FilesystemPreviewType {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}

type FileProgressCallback = {# type goffset #} -> {# type goffset #} -> IO ()
type FileReadMoreCallback = BS.ByteString -> IO Bool

fileNewForPath :: FilePath -> IO File
fileNewForPath path =
    withUTFString path $ {# call file_new_for_path #} >=> takeGObject

fileNewForURI :: String -> IO File
fileNewForURI uri =
    withUTFString uri $ {# call file_new_for_uri #} >=> takeGObject

fileNewForCommandlineArg :: String -> IO File
fileNewForCommandlineArg arg =
    withUTFString arg $ {# call file_new_for_commandline_arg #} >=> takeGObject

fileParseName :: String -> IO File
fileParseName parseName =
    withUTFString parseName $ {# call file_parse_name #} >=> takeGObject

fileDup :: FileClass file
        => file -> IO file
fileDup =
    {# call file_dup #} . toFile >=> takeGObject . castPtr

fileEqual :: (FileClass file1, FileClass file2)
          => file1 -> file2 -> IO Bool
fileEqual file1 file2 =
    liftM toBool $ {# call file_equal #} (toFile file1) (toFile file2)

fileGetBasename :: FileClass file => file -> IO String
fileGetBasename =
    {# call file_get_basename #} . toFile >=> readUTFString

fileGetPath :: FileClass file => file -> IO FilePath
fileGetPath =
    {# call file_get_path #} . toFile >=> readUTFString

fileGetURI :: FileClass file => file -> IO String
fileGetURI =
    {# call file_get_uri #} . toFile >=> readUTFString

fileGetParseName :: FileClass file => file -> IO String
fileGetParseName =
    {# call file_get_parse_name #} . toFile >=> readUTFString

fileGetParent :: FileClass file => file -> IO (Maybe File)
fileGetParent =
    {# call file_get_parent #} . toFile >=> maybePeek takeGObject

fileGetChild :: FileClass file => file -> String -> IO (Maybe File)
fileGetChild file name =
    withUTFString name $ {# call file_get_child #} (toFile file) >=> maybePeek takeGObject

fileGetChildForDisplayName :: FileClass file => file -> String -> IO File
fileGetChildForDisplayName file displayName =
    withUTFString displayName $ \cDisplayName ->
        propagateGError ({# call file_get_child_for_display_name #} (toFile file) cDisplayName) >>=
        takeGObject

fileHasPrefix :: (FileClass file1, FileClass file2) => file1 -> file2 -> IO Bool
fileHasPrefix file1 file2 =
    liftM toBool $ {# call file_has_prefix #} (toFile file1) (toFile file2)

fileGetRelativePath :: (FileClass file1, FileClass file2) => file1 -> file2 -> IO FilePath
fileGetRelativePath file1 file2 =
    {# call file_get_relative_path #} (toFile file1) (toFile file2) >>= readUTFString

fileResolveRelativePath :: FileClass file => file -> FilePath -> IO (Maybe File)
fileResolveRelativePath file relativePath =
    withUTFString relativePath $ \cRelativePath ->
        {# call file_resolve_relative_path #} (toFile file) cRelativePath >>=
        maybePeek takeGObject

fileIsNative :: FileClass file => file -> IO Bool
fileIsNative =
    liftM toBool . {# call file_is_native #} . toFile

fileHasURIScheme :: FileClass file => file -> String -> IO Bool
fileHasURIScheme file uriScheme =
    withUTFString uriScheme $ \cURIScheme ->
        liftM toBool $ {# call file_has_uri_scheme #} (toFile file) cURIScheme

fileGetURIScheme :: FileClass file => file -> IO String
fileGetURIScheme =
    {# call file_get_uri_scheme #} . toFile >=> readUTFString

fileRead :: FileClass file => file -> Maybe Cancellable -> IO FileInputStream
fileRead file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
            propagateGError (g_file_read cFile cCancellable) >>= takeGObject
    where _ = {# call file_read #}

fileReadAsync :: FileClass file
              => file
              -> Int
              -> Maybe Cancellable
              -> AsyncReadyCallback
              -> IO ()
fileReadAsync file ioPriority mbCancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject mbCancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_read_async cFile
                            (fromIntegral ioPriority)
                            cCancellable
                            cCallback
                            (castFunPtrToPtr cCallback)
    where _ = {# call file_read_async #}

fileReadFinish :: FileClass file
               => file
               -> AsyncResult
               -> IO FileInputStream
fileReadFinish file asyncResult =
    propagateGError ({# call file_read_finish #} (toFile file) asyncResult) >>= takeGObject

fileAppendTo :: FileClass file
             => file
             -> [FileCreateFlags]
             -> Maybe Cancellable
             -> IO FileOutputStream
fileAppendTo file flags cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_append_to cFile (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_append_to #}

fileCreate :: FileClass file
           => file
           -> [FileCreateFlags]
           -> Maybe Cancellable
           -> IO FileOutputStream
fileCreate file flags cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_create cFile (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_create #}

fileReplace :: FileClass file
            => file
            -> Maybe String
            -> Bool
            -> [FileCreateFlags]
            -> Maybe Cancellable
            -> IO FileOutputStream
fileReplace file etag makeBackup flags cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withUTFString etag $ \cEtag ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_replace cFile
                                        cEtag
                                        (fromBool makeBackup)
                                        (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_replace #}

fileAppendToAsync :: FileClass file
                  => file
                  -> [FileCreateFlags]
                  -> Int
                  -> Maybe Cancellable
                  -> AsyncReadyCallback
                  -> IO ()
fileAppendToAsync file flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_append_to_async cFile
                                 (cFromFlags flags)
                                 (fromIntegral ioPriority)
                                 cCancellable
                                 cCallback
                                 (castFunPtrToPtr cCallback)
    where _ = {# call file_append_to_async #}

fileAppendToFinish :: FileClass file
                   => file
                   -> AsyncResult
                   -> IO FileOutputStream
fileAppendToFinish file asyncResult =
    propagateGError ({# call file_append_to_finish #} (toFile file) asyncResult) >>= takeGObject

fileCreateAsync :: FileClass file
                  => file
                  -> [FileCreateFlags]
                  -> Int
                  -> Maybe Cancellable
                  -> AsyncReadyCallback
                  -> IO ()
fileCreateAsync file flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_create_async cFile
                              (cFromFlags flags)
                              (fromIntegral ioPriority)
                              cCancellable
                              cCallback
                              (castFunPtrToPtr cCallback)
    where _ = {# call file_create_async #}

fileCreateFinish :: FileClass file
                   => file
                   -> AsyncResult
                   -> IO FileOutputStream
fileCreateFinish file asyncResult =
    propagateGError ({# call file_create_finish #} (toFile file) asyncResult) >>= takeGObject

fileReplaceAsync :: FileClass file
                 => file
                 -> String
                 -> Bool
                 -> [FileCreateFlags]
                 -> Int
                 -> Maybe Cancellable
                 -> AsyncReadyCallback
                 -> IO ()
fileReplaceAsync file etag makeBackup flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString etag $ \cEtag ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_replace_async cFile
                               cEtag
                               (fromBool makeBackup)
                               (cFromFlags flags)
                               (fromIntegral ioPriority)
                               cCancellable
                               cCallback
                               (castFunPtrToPtr cCallback)
    where _ = {# call file_replace_async #}

fileReplaceFinish :: FileClass file
                  => file
                  -> AsyncResult
                  -> IO FileOutputStream
fileReplaceFinish file asyncResult =
    propagateGError ({# call file_replace_finish #} (toFile file) asyncResult) >>= takeGObject

fileQueryInfo :: FileClass file
              => file
              -> String
              -> [FileQueryInfoFlags]
              -> Maybe Cancellable
              -> IO FileInfo
fileQueryInfo file attributes flags cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_query_info cFile cAttributes (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_query_info #}

fileQueryInfoAsync :: FileClass file
                   => file
                   -> String
                   -> [FileQueryInfoFlags]
                   -> Int
                   -> Maybe Cancellable
                   -> AsyncReadyCallback
                   -> IO ()
fileQueryInfoAsync file attributes flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_query_info_async cFile
                                  cAttributes
                                  (cFromFlags flags)
                                  (fromIntegral ioPriority)
                                  cCancellable
                                  cCallback
                                  (castFunPtrToPtr cCallback)
    where _ = {# call file_query_info_async #}

fileQueryExists :: FileClass file
                => file
                -> Maybe Cancellable
                -> IO Bool
fileQueryExists file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
            liftM toBool $ g_file_query_exists cFile cCancellable
    where _ = {# call file_query_exists #}

fileQueryFilesystemInfo :: FileClass file
                        => file
                        -> String
                        -> Maybe Cancellable
                        -> IO FileInfo
fileQueryFilesystemInfo file attributes cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_query_filesystem_info cFile cAttributes cCancellable) >>=
        takeGObject
    where _ = {# call file_query_filesystem_info #}


Use 'SourceMarkClass mark => mark' replace SourceBuffer as function argument.

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) SourceMark
--
--  Author : Duncan Coutts, Andy Stewart
--  derived from GtkTextView bindings by Axel Simon
--
--  Created: 26 October 2003
--
--  Copyright (C) 2003-2005 Duncan Coutts, Axel Simon
--  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)
--
module Graphics.UI.Gtk.SourceView.SourceMark (
-- * Description
-- | A 'SourceMark' marks a position in the text where you want to display additional info. It is based
-- on 'TextMark' and thus is still valid after the text has changed though its position may change.
--
-- 'SourceMarks' are organised in categories which you have to set when you create the mark. Each
-- category can have a pixbuf and a priority associated using @gtkSourceViewSetMarkCategoryPixbuf@
-- and @gtkSourceViewSetMarkCategoryPriority@. The pixbuf will be displayed in the margin at the
-- line where the mark residents if the 'showLineMarks' property is set to 'True'. If there are
-- multiple marks in the same line, the pixbufs will be drawn on top of each other. The mark with the
-- highest priority will be drawn on top.

-- * Types
  SourceMark,
  SourceMarkClass,

-- * Methods
  castToSourceMark,
  sourceMarkNew,
  sourceMarkGetCategory,
  sourceMarkNext,
  sourceMarkPrev,

-- * Attributes
  sourceMarkCategory
) where

import Control.Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GObject	(makeNewGObject)
import System.Glib.Attributes
import System.Glib.Properties
{#import Graphics.UI.Gtk.SourceView.Types#}

{# context lib="gtk" prefix="gtk" #}

-- methods

-- | Creates a text mark. Add it to a buffer using 'textBufferAddMark'. If name is 'Nothing', the mark
-- is anonymous; otherwise, the mark can be retrieved by name using
-- 'textBufferGetMark'. Normally marks are created using the utility function
-- 'sourceBufferCreateMark'.
sourceMarkNew :: Maybe String -- ^ @name@     Name of the 'SourceMark', can be 'Nothing' when not using a name
              -> String  -- ^ @category@ is used to classify marks according to common characteristics (e.g. all the marks representing a bookmark could
              -> IO SourceMark
sourceMarkNew name category =
  makeNewGObject mkSourceMark $
  maybeWith withUTFString name $ \namePtr ->
  withUTFString category $ \categoryPtr ->
  {#call gtk_source_mark_new#}
    namePtr
    categoryPtr

-- | Returns the mark category
--
sourceMarkGetCategory :: SourceMarkClass mark => mark
                      -> IO String -- ^ returns the category of the 'SourceMark'
sourceMarkGetCategory mark = do
  strPtr <- {#call unsafe source_mark_get_category#} (toSourceMark mark)
  markType <- peekUTFString strPtr
  {#call unsafe g_free#} (castPtr strPtr)
  return markType

-- | Returns the next 'SourceMark' in the buffer or 'Nothing' if the mark was not added to a buffer. If there
-- is no next mark, 'Nothing' will be returned.
--
-- If category is 'Nothing', looks for marks of any category
--
sourceMarkNext :: SourceMarkClass mark => mark
               -> Maybe String  -- ^ @category@ a string specifying the mark category or 'Nothing'
               -> IO (Maybe SourceMark) -- ^ returns  the next 'SourceMark' or 'Nothing'
sourceMarkNext mark category =
    maybeNull (makeNewGObject mkSourceMark) $
    maybeWith withUTFString category $ {#call unsafe source_mark_next#} (toSourceMark mark)

-- | Returns the previous 'SourceMark' in the buffer or 'Nothing' if the mark was not added to a buffer. If
-- there is no previous mark, 'Nothing' is returned.
--
-- If category is 'Nothing', looks for marks of any category
--
sourceMarkPrev :: SourceMarkClass mark => mark
               -> Maybe String  -- ^ @category@ a string specifying the mark category or 'Nothing'
               -> IO (Maybe SourceMark) -- ^ returns  the previous 'SourceMark' or 'Nothing'
sourceMarkPrev mark category =
    maybeNull (makeNewGObject mkSourceMark) $
    maybeWith withUTFString category $ {#call unsafe source_mark_prev#} (toSourceMark mark)

-- | The category of the 'SourceMark', classifies the mark and controls which pixbuf is used and with
-- which priority it is drawn.
-- Default value: \"\"
--
sourceMarkCategory :: SourceMarkClass mark => Attr mark String
sourceMarkCategory = newAttrFromStringProperty "category"

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) SourceMark
--
--  Author : Duncan Coutts, Andy Stewart
--  derived from GtkTextView bindings by Axel Simon
--
--  Created: 26 October 2003
--
--  Copyright (C) 2003-2005 Duncan Coutts, Axel Simon
--  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)
--
module Graphics.UI.Gtk.SourceView.SourceMark (
-- * Description
-- | A 'SourceMark' marks a position in the text where you want to display additional info. It is based
-- on 'TextMark' and thus is still valid after the text has changed though its position may change.
--
-- 'SourceMarks' are organised in categories which you have to set when you create the mark. Each
-- category can have a pixbuf and a priority associated using @gtkSourceViewSetMarkCategoryPixbuf@
-- and @gtkSourceViewSetMarkCategoryPriority@. The pixbuf will be displayed in the margin at the
-- line where the mark residents if the 'showLineMarks' property is set to 'True'. If there are
-- multiple marks in the same line, the pixbufs will be drawn on top of each other. The mark with the
-- highest priority will be drawn on top.

-- * Types
  SourceMark,

-- * Methods
  castToSourceMark,
  sourceMarkNew,
  sourceMarkGetCategory,
  sourceMarkNext,
  sourceMarkPrev,

-- * Attributes
  sourceMarkCategory
) where

import Control.Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GObject	(makeNewGObject)
import System.Glib.Attributes
import System.Glib.Properties
{#import Graphics.UI.Gtk.SourceView.Types#}

{# context lib="gtk" prefix="gtk" #}

-- methods

-- | Creates a text mark. Add it to a buffer using 'textBufferAddMark'. If name is 'Nothing', the mark
-- is anonymous; otherwise, the mark can be retrieved by name using
-- 'textBufferGetMark'. Normally marks are created using the utility function
-- 'sourceBufferCreateMark'.
sourceMarkNew :: Maybe String -- ^ @name@     Name of the 'SourceMark', can be 'Nothing' when not using a name
              -> String  -- ^ @category@ is used to classify marks according to common characteristics (e.g. all the marks representing a bookmark could
              -> IO SourceMark
sourceMarkNew name category =
  makeNewGObject mkSourceMark $
  maybeWith withUTFString name $ \namePtr ->
  withUTFString category $ \categoryPtr ->
  {#call gtk_source_mark_new#}
    namePtr
    categoryPtr

-- | Returns the mark category
--
sourceMarkGetCategory :: SourceMark
                      -> IO String -- ^ returns the category of the 'SourceMark'
sourceMarkGetCategory mark = do
  strPtr <- {#call unsafe source_mark_get_category#} mark
  markType <- peekUTFString strPtr
  {#call unsafe g_free#} (castPtr strPtr)
  return markType

-- | Returns the next 'SourceMark' in the buffer or 'Nothing' if the mark was not added to a buffer. If there
-- is no next mark, 'Nothing' will be returned.
--
-- If category is 'Nothing', looks for marks of any category
--
sourceMarkNext :: SourceMark
               -> Maybe String  -- ^ @category@ a string specifying the mark category or 'Nothing'
               -> IO (Maybe SourceMark) -- ^ returns  the next 'SourceMark' or 'Nothing'
sourceMarkNext mark category =
    maybeNull (makeNewGObject mkSourceMark) $
    maybeWith withUTFString category $ {#call unsafe source_mark_next#} mark

-- | Returns the previous 'SourceMark' in the buffer or 'Nothing' if the mark was not added to a buffer. If
-- there is no previous mark, 'Nothing' is returned.
--
-- If category is 'Nothing', looks for marks of any category
--
sourceMarkPrev :: SourceMark
               -> Maybe String  -- ^ @category@ a string specifying the mark category or 'Nothing'
               -> IO (Maybe SourceMark) -- ^ returns  the previous 'SourceMark' or 'Nothing'
sourceMarkPrev mark category =
    maybeNull (makeNewGObject mkSourceMark) $
    maybeWith withUTFString category $ {#call unsafe source_mark_prev#} mark

-- | The category of the 'SourceMark', classifies the mark and controls which pixbuf is used and with
-- which priority it is drawn.
-- Default value: \"\"
--
sourceMarkCategory :: Attr SourceMark String
sourceMarkCategory = newAttrFromStringProperty "category"


Must not use _static version of pango_font_description_set_family Since the string buffer is only kept around temporarily, not forever like pango_font_description_set_family_static requires.

-- -*-haskell-*-
--  GIMP Toolkit (GTK) - text layout functions: Font Descriptions
--
--  Author : Axel Simon
--
--  Created: 8 Feburary 2003
--
--  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.
--
-- #hide

-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- Functions to manage font descriptions.
--
-- * Font descriptions provide a way to query and state requirements on
--   fonts. This data structure has several fields describing different
--   characteristics of a font. Each of these fields can be set of left
--   unspecified.
--
module Graphics.UI.Gtk.Pango.Description (
  FontDescription,
  fontDescriptionNew,
  fontDescriptionCopy,
  fontDescriptionSetFamily,
  fontDescriptionGetFamily,
  fontDescriptionSetStyle,
  fontDescriptionGetStyle,
  fontDescriptionSetVariant,
  fontDescriptionGetVariant,
  fontDescriptionSetWeight,
  fontDescriptionGetWeight,
  fontDescriptionSetStretch,
  fontDescriptionGetStretch,
  fontDescriptionSetSize,
  fontDescriptionGetSize,
  FontMask(..),
  fontDescriptionUnsetFields,
  fontDescriptionMerge,
  fontDescriptionBetterMatch,
  fontDescriptionFromString,
  fontDescriptionToString
  ) where

import Control.Monad    (liftM)

import System.Glib.FFI
import System.Glib.Flags		(Flags, fromFlags)
import System.Glib.UTFString
{#import Graphics.UI.Gtk.Types#} ()
{#import Graphics.UI.Gtk.Pango.Types#}
import Graphics.UI.Gtk.Pango.Enums

{# context lib="pango" prefix="pango_font_description" #}

-- | Create a new font description.
--
-- * All field are unset.
--
fontDescriptionNew :: IO FontDescription
fontDescriptionNew = {#call unsafe new#} >>= makeNewFontDescription

-- | Make a deep copy of a font description.
--
fontDescriptionCopy :: FontDescription -> IO FontDescription
fontDescriptionCopy fd = {#call unsafe copy#} fd >>= makeNewFontDescription

-- | Set the font famliy.
--
-- * A font family is a name designating the design of the font (e.g. Sans
--   or Times) without the variant.
--
-- * In some contexts a comma separated list of font families can be used.
--
fontDescriptionSetFamily :: FontDescription -> String -> IO ()
fontDescriptionSetFamily fd family = withUTFString family $ \strPtr ->
  {#call unsafe set_family#} fd strPtr

-- | Get the font family.
--
-- * 'Nothing' is returned if the font family is not set.
--
fontDescriptionGetFamily :: FontDescription -> IO (Maybe String)
fontDescriptionGetFamily fd = do
  strPtr <- {#call unsafe get_family#} fd
  if strPtr==nullPtr then return Nothing else
    liftM Just $ peekUTFString strPtr

-- | Flags denoting which fields in a font description are set.
{#enum PangoFontMask as FontMask {underscoreToCase} deriving(Bounded) #}

instance Flags FontMask

-- | Set the style field.
--
-- * Most fonts will have either a 'StyleItalic' or 'StyleOblique'
--   but rarely both.
--
fontDescriptionSetStyle :: FontDescription -> FontStyle -> IO ()
fontDescriptionSetStyle fd p =
    {#call unsafe set_style#} fd (fromIntegral (fromEnum p))

-- | Get the style field.
fontDescriptionGetStyle :: FontDescription -> IO (Maybe FontStyle)
fontDescriptionGetStyle fd = do
  fields <- {#call unsafe get_set_fields#} fd
  if (fromEnum PangoFontMaskStyle) .&. (fromIntegral fields) /=0
     then liftM (Just . toEnum . fromIntegral) $
	      {#call unsafe get_style#} fd
     else return Nothing

-- | Set the variant field.
--
fontDescriptionSetVariant :: FontDescription -> Variant -> IO ()
fontDescriptionSetVariant fd p =
    {#call unsafe set_variant#} fd (fromIntegral (fromEnum p))

-- | Get the variant field.
fontDescriptionGetVariant :: FontDescription -> IO (Maybe Variant)
fontDescriptionGetVariant fd = do
  fields <- {#call unsafe get_set_fields#} fd
  if (fromEnum PangoFontMaskVariant) .&. (fromIntegral fields) /=0
     then liftM (Just . toEnum . fromIntegral) $
	      {#call unsafe get_variant#} fd
     else return Nothing

-- | Set the weight field.
--
fontDescriptionSetWeight :: FontDescription -> Weight -> IO ()
fontDescriptionSetWeight fd p =
  {#call unsafe set_weight#} fd (fromIntegral (fromEnum p))

-- | Get the weight field.
fontDescriptionGetWeight :: FontDescription -> IO (Maybe Weight)
fontDescriptionGetWeight fd = do
  fields <- {#call unsafe get_set_fields#} fd
  if (fromEnum PangoFontMaskWeight) .&. (fromIntegral fields) /=0
     then liftM (Just . toEnum . fromIntegral) $
	      {#call unsafe get_weight#} fd
     else return Nothing

-- | Set the stretch field.
--
fontDescriptionSetStretch :: FontDescription -> Stretch -> IO ()
fontDescriptionSetStretch fd p =
  {#call unsafe set_stretch#} fd (fromIntegral (fromEnum p))

-- | Get the stretch field.
fontDescriptionGetStretch :: FontDescription -> IO (Maybe Stretch)
fontDescriptionGetStretch fd = do
  fields <- {#call unsafe get_set_fields#} fd
  if (fromEnum PangoFontMaskStretch) .&. (fromIntegral fields) /=0
     then liftM (Just . toEnum . fromIntegral) $
	      {#call unsafe get_stretch#} fd
     else return Nothing

-- | Set the size field.
--
-- * The given size is in points (pts). One point is 1\/72 inch.
--
fontDescriptionSetSize :: FontDescription -> Double -> IO ()
fontDescriptionSetSize fd p =
  {#call unsafe set_size#} fd (puToInt p)

-- | Get the size field.
fontDescriptionGetSize :: FontDescription -> IO (Maybe Double)
fontDescriptionGetSize fd = do
  fields <- {#call unsafe get_set_fields#} fd
  if (fromEnum PangoFontMaskSize) .&. (fromIntegral fields) /=0
     then liftM (\x -> Just (intToPu x)) $
	      {#call unsafe get_size#} fd
     else return Nothing

-- | Reset fields in a font description.
--
fontDescriptionUnsetFields :: FontDescription -> [FontMask] -> IO ()
fontDescriptionUnsetFields fd mask =
  {#call unsafe unset_fields#} fd (fromIntegral (fromFlags mask))

-- | Merge two font descriptions.
--
-- * Copy fields from the second description to the first. If the boolean
--   parameter is set, existing fields in the first description will be
--   replaced.
--
fontDescriptionMerge :: FontDescription -> FontDescription -> Bool -> IO ()
fontDescriptionMerge fd1 fd2 replace =
  {#call unsafe merge#} fd1 fd2 (fromBool replace)

-- | Determine if two descriptions are simliar.
--
-- * Returns 'True' if the two descriptions only differ in weight or style.
--
fontDescriptionIsMatch :: FontDescription -> FontDescription -> Bool
fontDescriptionIsMatch fdA fdB = unsafePerformIO $ liftM toBool $
  {#call unsafe better_match#} fdA (FontDescription nullForeignPtr) fdB

-- | Determine which of two descriptions matches a given description better.
--
-- * Returns @True@ if the last description is a better match to the first
--   arguement than the middle one.
--
-- * Approximate matching is done on weight and style. If the other
--   attributes do not match, the function returns @False@.
--
fontDescriptionBetterMatch :: FontDescription -> FontDescription ->
			      FontDescription -> Bool
fontDescriptionBetterMatch fd fdA fdB = unsafePerformIO $ liftM toBool $
  {#call unsafe better_match#} fd fdA fdB

-- | Create a font description from a string.
--
-- * The given argument must have the form
--   @[FAMILY-LIST] [STYLE-OPTIONS] [SIZE]@ where @FAMILY_LIST@ is a comma
--   separated list of font families optionally terminated by a comma,
--   @STYLE_OPTIONS@ is a whitespace separated list of words where each
--   word describes one of style, variant, weight or stretch. @SIZE@ is
--   a decimal number giving the size of the font in points. If any of
--   these fields is absent, the resulting 'FontDescription' will have
--   the corresponing fields unset.
--
fontDescriptionFromString :: String -> IO FontDescription
fontDescriptionFromString descr = withUTFString descr $ \strPtr ->
  {#call unsafe from_string#} strPtr >>= makeNewFontDescription

-- | Convert a font description to a string.
--
-- * Creates a string representation of a font description. See
--   'fontDescriptionFromString' for the format of the string.
--
fontDescriptionToString :: FontDescription -> IO String
fontDescriptionToString fd = do
  strPtr <- {#call unsafe to_string#} fd
  str <- peekUTFString strPtr
  {#call unsafe g_free#} (castPtr strPtr)
  return str

-- -*-haskell-*-
--  GIMP Toolkit (GTK) - text layout functions: Font Descriptions
--
--  Author : Axel Simon
--
--  Created: 8 Feburary 2003
--
--  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.
--
-- #hide

-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- Functions to manage font descriptions.
--
-- * Font descriptions provide a way to query and state requirements on
--   fonts. This data structure has several fields describing different
--   characteristics of a font. Each of these fields can be set of left
--   unspecified.
--
module Graphics.UI.Gtk.Pango.Description (
  FontDescription,
  fontDescriptionNew,
  fontDescriptionCopy,
  fontDescriptionSetFamily,
  fontDescriptionGetFamily,
  fontDescriptionSetStyle,
  fontDescriptionGetStyle,
  fontDescriptionSetVariant,
  fontDescriptionGetVariant,
  fontDescriptionSetWeight,
  fontDescriptionGetWeight,
  fontDescriptionSetStretch,
  fontDescriptionGetStretch,
  fontDescriptionSetSize,
  fontDescriptionGetSize,
  FontMask(..),
  fontDescriptionUnsetFields,
  fontDescriptionMerge,
  fontDescriptionBetterMatch,
  fontDescriptionFromString,
  fontDescriptionToString
  ) where

import Control.Monad    (liftM)

import System.Glib.FFI
import System.Glib.Flags		(Flags, fromFlags)
import System.Glib.UTFString
{#import Graphics.UI.Gtk.Types#} ()
{#import Graphics.UI.Gtk.Pango.Types#}
import Graphics.UI.Gtk.Pango.Enums

{# context lib="pango" prefix="pango_font_description" #}

-- | Create a new font description.
--
-- * All field are unset.
--
fontDescriptionNew :: IO FontDescription
fontDescriptionNew = {#call unsafe new#} >>= makeNewFontDescription

-- | Make a deep copy of a font description.
--
fontDescriptionCopy :: FontDescription -> IO FontDescription
fontDescriptionCopy fd = {#call unsafe copy#} fd >>= makeNewFontDescription

-- | Set the font famliy.
--
-- * A font family is a name designating the design of the font (e.g. Sans
--   or Times) without the variant.
--
-- * In some contexts a comma separated list of font families can be used.
--
fontDescriptionSetFamily :: FontDescription -> String -> IO ()
fontDescriptionSetFamily fd family = withUTFString family $ \strPtr ->
  {#call unsafe set_family_static#} fd strPtr

-- | Get the font family.
--
-- * 'Nothing' is returned if the font family is not set.
--
fontDescriptionGetFamily :: FontDescription -> IO (Maybe String)
fontDescriptionGetFamily fd = do
  strPtr <- {#call unsafe get_family#} fd
  if strPtr==nullPtr then return Nothing else
    liftM Just $ peekUTFString strPtr

-- | Flags denoting which fields in a font description are set.
{#enum PangoFontMask as FontMask {underscoreToCase} deriving(Bounded) #}

instance Flags FontMask

-- | Set the style field.
--
-- * Most fonts will have either a 'StyleItalic' or 'StyleOblique'
--   but rarely both.
--
fontDescriptionSetStyle :: FontDescription -> FontStyle -> IO ()
fontDescriptionSetStyle fd p =
    {#call unsafe set_style#} fd (fromIntegral (fromEnum p))

-- | Get the style field.
fontDescriptionGetStyle :: FontDescription -> IO (Maybe FontStyle)
fontDescriptionGetStyle fd = do
  fields <- {#call unsafe get_set_fields#} fd
  if (fromEnum PangoFontMaskStyle) .&. (fromIntegral fields) /=0
     then liftM (Just . toEnum . fromIntegral) $
	      {#call unsafe get_style#} fd
     else return Nothing

-- | Set the variant field.
--
fontDescriptionSetVariant :: FontDescription -> Variant -> IO ()
fontDescriptionSetVariant fd p =
    {#call unsafe set_variant#} fd (fromIntegral (fromEnum p))

-- | Get the variant field.
fontDescriptionGetVariant :: FontDescription -> IO (Maybe Variant)
fontDescriptionGetVariant fd = do
  fields <- {#call unsafe get_set_fields#} fd
  if (fromEnum PangoFontMaskVariant) .&. (fromIntegral fields) /=0
     then liftM (Just . toEnum . fromIntegral) $
	      {#call unsafe get_variant#} fd
     else return Nothing

-- | Set the weight field.
--
fontDescriptionSetWeight :: FontDescription -> Weight -> IO ()
fontDescriptionSetWeight fd p =
  {#call unsafe set_weight#} fd (fromIntegral (fromEnum p))

-- | Get the weight field.
fontDescriptionGetWeight :: FontDescription -> IO (Maybe Weight)
fontDescriptionGetWeight fd = do
  fields <- {#call unsafe get_set_fields#} fd
  if (fromEnum PangoFontMaskWeight) .&. (fromIntegral fields) /=0
     then liftM (Just . toEnum . fromIntegral) $
	      {#call unsafe get_weight#} fd
     else return Nothing

-- | Set the stretch field.
--
fontDescriptionSetStretch :: FontDescription -> Stretch -> IO ()
fontDescriptionSetStretch fd p =
  {#call unsafe set_stretch#} fd (fromIntegral (fromEnum p))

-- | Get the stretch field.
fontDescriptionGetStretch :: FontDescription -> IO (Maybe Stretch)
fontDescriptionGetStretch fd = do
  fields <- {#call unsafe get_set_fields#} fd
  if (fromEnum PangoFontMaskStretch) .&. (fromIntegral fields) /=0
     then liftM (Just . toEnum . fromIntegral) $
	      {#call unsafe get_stretch#} fd
     else return Nothing

-- | Set the size field.
--
-- * The given size is in points (pts). One point is 1\/72 inch.
--
fontDescriptionSetSize :: FontDescription -> Double -> IO ()
fontDescriptionSetSize fd p =
  {#call unsafe set_size#} fd (puToInt p)

-- | Get the size field.
fontDescriptionGetSize :: FontDescription -> IO (Maybe Double)
fontDescriptionGetSize fd = do
  fields <- {#call unsafe get_set_fields#} fd
  if (fromEnum PangoFontMaskSize) .&. (fromIntegral fields) /=0
     then liftM (\x -> Just (intToPu x)) $
	      {#call unsafe get_size#} fd
     else return Nothing

-- | Reset fields in a font description.
--
fontDescriptionUnsetFields :: FontDescription -> [FontMask] -> IO ()
fontDescriptionUnsetFields fd mask =
  {#call unsafe unset_fields#} fd (fromIntegral (fromFlags mask))

-- | Merge two font descriptions.
--
-- * Copy fields from the second description to the first. If the boolean
--   parameter is set, existing fields in the first description will be
--   replaced.
--
fontDescriptionMerge :: FontDescription -> FontDescription -> Bool -> IO ()
fontDescriptionMerge fd1 fd2 replace =
  {#call unsafe merge#} fd1 fd2 (fromBool replace)

-- | Determine if two descriptions are simliar.
--
-- * Returns 'True' if the two descriptions only differ in weight or style.
--
fontDescriptionIsMatch :: FontDescription -> FontDescription -> Bool
fontDescriptionIsMatch fdA fdB = unsafePerformIO $ liftM toBool $
  {#call unsafe better_match#} fdA (FontDescription nullForeignPtr) fdB

-- | Determine which of two descriptions matches a given description better.
--
-- * Returns @True@ if the last description is a better match to the first
--   arguement than the middle one.
--
-- * Approximate matching is done on weight and style. If the other
--   attributes do not match, the function returns @False@.
--
fontDescriptionBetterMatch :: FontDescription -> FontDescription ->
			      FontDescription -> Bool
fontDescriptionBetterMatch fd fdA fdB = unsafePerformIO $ liftM toBool $
  {#call unsafe better_match#} fd fdA fdB

-- | Create a font description from a string.
--
-- * The given argument must have the form
--   @[FAMILY-LIST] [STYLE-OPTIONS] [SIZE]@ where @FAMILY_LIST@ is a comma
--   separated list of font families optionally terminated by a comma,
--   @STYLE_OPTIONS@ is a whitespace separated list of words where each
--   word describes one of style, variant, weight or stretch. @SIZE@ is
--   a decimal number giving the size of the font in points. If any of
--   these fields is absent, the resulting 'FontDescription' will have
--   the corresponing fields unset.
--
fontDescriptionFromString :: String -> IO FontDescription
fontDescriptionFromString descr = withUTFString descr $ \strPtr ->
  {#call unsafe from_string#} strPtr >>= makeNewFontDescription

-- | Convert a font description to a string.
--
-- * Creates a string representation of a font description. See
--   'fontDescriptionFromString' for the format of the string.
--
fontDescriptionToString :: FontDescription -> IO String
fontDescriptionToString fd = do
  strPtr <- {#call unsafe to_string#} fd
  str <- peekUTFString strPtr
  {#call unsafe g_free#} (castPtr strPtr)
  return str


[project @ 2002-07-17 16:02:09 by juhp]

[project @ 2002-07-17 16:02:09 by juhp]

(scrolledWindowNew): Make it maybe take Adjustments, passing
a null ptr when Nothing is given.

darcs-hash:20020717160209-f332a-688ea27842d8a650cae3df7245a8f9e508f4486a.gz

-- -*-haskell-*-
--  GIMP Toolkit (GTK) @entry Widget ScrolledWindow@
--
--  Author : Axel Simon
--
--  Created: 23 May 2001
--
--  Version $Revision: 1.3 $ from $Date: 2002/07/17 16:02:09 $
--
--  Copyright (c) 1999..2002 Axel Simon
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file 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 General Public License for more details.
--
-- @description@ --------------------------------------------------------------
--
-- * @ScrolledWindow is a container that adds scroll bars to its child. Some
--   widgets have native scrolling support, in which case the scrolling action
--   is performed by the child itself (e.g. a TreeView widget does this by only
--   moving the table part and not the titles of a table). If a widget does
--   not support native scrolling it has to be put into a @TreeView widget.
--
-- @documentation@ ------------------------------------------------------------
--
--
-- @todo@ ---------------------------------------------------------------------

module ScrolledWindow(
  ScrolledWindow,
  ScrolledWindowClass,
  castToScrolledWindow,
  scrolledWindowNew,
  scrolledWindowGetHAdjustment,
  scrolledWindowGetVAdjustment,
  PolicyType(..),
  scrolledWindowSetPolicy,
  scrolledWindowAddWithViewport,
  CornerType(..),
  scrolledWindowSetPlacement,
  ShadowType(..),
  scrolledWindowSetShadowType,
  scrolledWindowSetHAdjustment,
  scrolledWindowSetVAdjustment,
  ) where

import Monad	(liftM)
import Foreign
import UTFCForeign
import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}
import Enums	(PolicyType(..), CornerType(..), ShadowType(..))
import Maybe    (fromMaybe)
import Structs  (nullForeignPtr)

{# context lib="gtk" prefix="gtk" #}

-- methods

-- @constructor scrolledWindowNew@ Create a new @ref type ScrolledWindow@.
--
scrolledWindowNew :: Maybe Adjustment -> Maybe Adjustment -> IO ScrolledWindow
scrolledWindowNew hAdj vAdj = makeNewObject mkScrolledWindow $ liftM castPtr $
  {#call unsafe scrolled_window_new#} (fromMAdj hAdj) (fromMAdj vAdj)
 where
 fromMAdj :: Maybe Adjustment -> Adjustment
 fromMAdj = fromMaybe $ mkAdjustment nullForeignPtr

-- @method scrolledWindowGetHAdjustment@ Retrieve the horizontal
-- @ref arg Adjustment@ of the @ref type ScrolledWindow@.
--
scrolledWindowGetHAdjustment :: ScrolledWindowClass w => w -> IO Adjustment
scrolledWindowGetHAdjustment w = makeNewObject mkAdjustment $
  {#call unsafe scrolled_window_get_hadjustment#} (toScrolledWindow w)

-- @method scrolledWindowGetVAdjustment@ Retrieve the vertical
-- @ref arg Adjustment@ of the @ref type ScrolledWindow@.
--
scrolledWindowGetVAdjustment :: ScrolledWindowClass w => w -> IO Adjustment
scrolledWindowGetVAdjustment w = makeNewObject mkAdjustment $
  {#call unsafe scrolled_window_get_vadjustment#} (toScrolledWindow w)

-- @method scrolledWindowSetPolicy@ Specify if the scrollbars should vanish if
-- the child size is sufficiently small.
--
scrolledWindowSetPolicy :: ScrolledWindowClass w => w -> PolicyType ->
                           PolicyType -> IO ()
scrolledWindowSetPolicy w hPol vPol = {#call scrolled_window_set_policy#}
  (toScrolledWindow w) ((fromIntegral.fromEnum) hPol)
  ((fromIntegral.fromEnum) vPol)

-- @method scrolledWindowAddWithViewport@ Add a child widget without native
-- scrolling support to this @ref type ScrolledWindow@.
--
scrolledWindowAddWithViewport :: (ScrolledWindowClass w, WidgetClass wid) =>
                                 w -> wid -> IO ()
scrolledWindowAddWithViewport w wid =
  {#call scrolled_window_add_with_viewport#} (toScrolledWindow w)
  (toWidget wid)

-- @method scrolledWindowSetPlacement@ Specify where the scrollbars should be
-- placed.
--
scrolledWindowSetPlacement :: ScrolledWindowClass w => w -> CornerType -> IO ()
scrolledWindowSetPlacement w ct =
  {#call scrolled_window_set_placement#} (toScrolledWindow w)
  ((fromIntegral.fromEnum) ct)

-- @method scrolledWindowSetShadowType@ Specify if and how an outer frame
-- should be drawn around the child.
--
scrolledWindowSetShadowType :: ScrolledWindowClass w => w -> ShadowType ->
                               IO ()
scrolledWindowSetShadowType w st = {#call scrolled_window_set_shadow_type#}
  (toScrolledWindow w) ((fromIntegral.fromEnum) st)

-- @method scrolledWindowSetHAdjustment@ Set the horizontal
-- @ref arg Adjustment@ of the @ref type ScrolledWindow@.
--
scrolledWindowSetHAdjustment :: ScrolledWindowClass w => w -> Adjustment ->
                                IO ()
scrolledWindowSetHAdjustment w adj = {#call scrolled_window_set_hadjustment#}
  (toScrolledWindow w) adj

-- @method scrolledWindowSetVAdjustment@ Set the vertical @ref arg Adjustment@
-- of the @ref type ScrolledWindow@.
--
scrolledWindowSetVAdjustment :: ScrolledWindowClass w => w -> Adjustment ->
                                IO ()
scrolledWindowSetVAdjustment w adj = {#call scrolled_window_set_hadjustment#}
  (toScrolledWindow w) adj

-- -*-haskell-*-
--  GIMP Toolkit (GTK) @entry Widget ScrolledWindow@
--
--  Author : Axel Simon
--
--  Created: 23 May 2001
--
--  Version $Revision: 1.2 $ from $Date: 2002/05/24 09:43:25 $
--
--  Copyright (c) 1999..2002 Axel Simon
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file 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 General Public License for more details.
--
-- @description@ --------------------------------------------------------------
--
-- * @ScrolledWindow is a container that adds scroll bars to its child. Some
--   widgets have native scrolling support, in which case the scrolling action
--   is performed by the child itself (e.g. a TreeView widget does this by only
--   moving the table part and not the titles of a table). If a widget does
--   not support native scrolling it has to be put into a @TreeView widget.
--
-- @documentation@ ------------------------------------------------------------
--
--
-- @todo@ ---------------------------------------------------------------------

module ScrolledWindow(
  ScrolledWindow,
  ScrolledWindowClass,
  castToScrolledWindow,
  scrolledWindowNew,
  scrolledWindowGetHAdjustment,
  scrolledWindowGetVAdjustment,
  PolicyType(..),
  scrolledWindowSetPolicy,
  scrolledWindowAddWithViewport,
  CornerType(..),
  scrolledWindowSetPlacement,
  ShadowType(..),
  scrolledWindowSetShadowType,
  scrolledWindowSetHAdjustment,
  scrolledWindowSetVAdjustment,
  ) where

import Monad	(liftM)
import Foreign
import UTFCForeign
import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}
import Enums	(PolicyType(..), CornerType(..), ShadowType(..))

{# context lib="gtk" prefix="gtk" #}

-- methods

-- @constructor scrolledWindowNew@ Create a new @ref type ScrolledWindow@.
--
scrolledWindowNew :: Adjustment -> Adjustment -> IO ScrolledWindow
scrolledWindowNew vAdj hAdj = makeNewObject mkScrolledWindow $ liftM castPtr $
  {#call unsafe scrolled_window_new#} hAdj vAdj

-- @method scrolledWindowGetHAdjustment@ Retrieve the horizontal
-- @ref arg Adjustment@ of the @ref type ScrolledWindow@.
--
scrolledWindowGetHAdjustment :: ScrolledWindowClass w => w -> IO Adjustment
scrolledWindowGetHAdjustment w = makeNewObject mkAdjustment $
  {#call unsafe scrolled_window_get_hadjustment#} (toScrolledWindow w)

-- @method scrolledWindowGetVAdjustment@ Retrieve the vertical
-- @ref arg Adjustment@ of the @ref type ScrolledWindow@.
--
scrolledWindowGetVAdjustment :: ScrolledWindowClass w => w -> IO Adjustment
scrolledWindowGetVAdjustment w = makeNewObject mkAdjustment $
  {#call unsafe scrolled_window_get_vadjustment#} (toScrolledWindow w)

-- @method scrolledWindowSetPolicy@ Specify if the scrollbars should vanish if
-- the child size is sufficiently small.
--
scrolledWindowSetPolicy :: ScrolledWindowClass w => w -> PolicyType ->
                           PolicyType -> IO ()
scrolledWindowSetPolicy w hPol vPol = {#call scrolled_window_set_policy#}
  (toScrolledWindow w) ((fromIntegral.fromEnum) hPol)
  ((fromIntegral.fromEnum) vPol)

-- @method scrolledWindowAddWithViewport@ Add a child widget without native
-- scrolling support to this @ref type ScrolledWindow@.
--
scrolledWindowAddWithViewport :: (ScrolledWindowClass w, WidgetClass wid) =>
                                 w -> wid -> IO ()
scrolledWindowAddWithViewport w wid =
  {#call scrolled_window_add_with_viewport#} (toScrolledWindow w)
  (toWidget wid)

-- @method scrolledWindowSetPlacement@ Specify where the scrollbars should be
-- placed.
--
scrolledWindowSetPlacement :: ScrolledWindowClass w => w -> CornerType -> IO ()
scrolledWindowSetPlacement w ct =
  {#call scrolled_window_set_placement#} (toScrolledWindow w)
  ((fromIntegral.fromEnum) ct)

-- @method scrolledWindowSetShadowType@ Specify if and how an outer frame
-- should be drawn around the child.
--
scrolledWindowSetShadowType :: ScrolledWindowClass w => w -> ShadowType ->
                               IO ()
scrolledWindowSetShadowType w st = {#call scrolled_window_set_shadow_type#}
  (toScrolledWindow w) ((fromIntegral.fromEnum) st)

-- @method scrolledWindowSetHAdjustment@ Set the horizontal
-- @ref arg Adjustment@ of the @ref type ScrolledWindow@.
--
scrolledWindowSetHAdjustment :: ScrolledWindowClass w => w -> Adjustment ->
                                IO ()
scrolledWindowSetHAdjustment w adj = {#call scrolled_window_set_hadjustment#}
  (toScrolledWindow w) adj

-- @method scrolledWindowSetVAdjustment@ Set the vertical @ref arg Adjustment@
-- of the @ref type ScrolledWindow@.
--
scrolledWindowSetVAdjustment :: ScrolledWindowClass w => w -> Adjustment ->
                                IO ()
scrolledWindowSetVAdjustment w adj = {#call scrolled_window_set_hadjustment#}
  (toScrolledWindow w) adj