gtk2hs-commit — Mailing list for Darcs commit messages.

[Gtk2hs-commit] gtk2hs ChangeLog,1.230,1.231 Makefile.am,1.2,1.3

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24829

Modified Files:
	ChangeLog Makefile.am 
Log Message:
Enhance makefile so that it builds the library. Changed .chspp to .chs.cpp in
all pre-processed chs files. Build with ghc --make the first time and with
ghc -c on incremental changes.


Index: Makefile.am
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/Makefile.am,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- Makefile.am	25 Oct 2004 08:49:40 -0000	1.2
+++ Makefile.am	27 Oct 2004 13:21:38 -0000	1.3
@@ -1,6 +1,7 @@
 AUTOMAKE_OPTIONS = foreign subdir-objects
-
-SUFFIXES = .chspp .chs .hsc
+SUFFIXES = .chs.cpp .chs .hsc
+CLEANFILES = $(DEPDIR)*.dep
+DISTCLEANFILES = *.precomp
 
 SOURCEDIRS = gtk/general gtk/glib gtk/pango gtk/treeList gtk/multiline \
 	gtk/gdk gtk/abstract gtk/display gtk/entry gtk/misc gtk/multiline \
@@ -12,13 +13,9 @@
 
 CHSDEPEND = $(srcdir)/mk/chsDepend
 
-HSC = hsc2hs
+DEPDIR = $(addsuffix /,@DEPDIR@)
 
-# Flags for the C compiler and C pre-processor.
-# *_CFLAGS variables contain general flags for the C compiler. A subset of
-# these, namely just the -I flags, are always available in *_CPPFLAGS.
-# Breaking this convention is the automake built-in AM_CPPFLAGS to which
-# no AM_CFLAGS exit.
+HSC = hsc2hs
 
 # While building lib<name>, set the variable NAME to <name> so we can access
 # the package-specific variable <name>_HEADER, <name>_PACKAGE, etc. The
@@ -181,18 +178,23 @@
 libgtk2hs_a_CHSFILES_HS = $(patsubst %.chs,%.hs,\
 	$(patsubst %.chspp,%.hs,$(libgtk2hs_a_CHSFILES)))
 libgtk2hs_a_HSCFILES = $(filter %.hsc, $(libgtk2hs_a_SOURCES))
+libgtk2hs_a_HSCFILES_HS = $(libgtk2hs_a_HSCFILES:.hsc=.hs)
 libgtk2hs_a_BUILDSOURCES = \
 	$(libgtk2hs_a_CHSFILES_HS) \
-	$(libgtk2hs_a_HSCFILES:.hsc=.hs)
+	$(libgtk2hs_a_HSCFILES_HS)
 libgtk2hs_a_HSFILES  = \
 	$(libgtk2hs_a_BUILDSOURCES) \
 	$(filter %.hs,$(libgtk2hs_a_SOURCES))
+MOSTLYCLEANFILES = $(libgtk2hs_a_HSFILES:.hs=.$(OBJEXT))
+CLEANFILES+= $(libgtk2hs_a_BUILDSOURCES)
 
-
-
-
+# A file with CPP defines that reflect the current configuration.
 CONFIG_H = config.h
 
+# The local GHC package file for compiling files that depend on packages
+# that we have built but not yet installed.
+LOCALPACKAGE = localpackages.conf
+
 EMPTY =
 SPACE = $(EMPTY) $(EMPTY)
 VPATH = $(subst $(SPACE),:,$(strip \
@@ -202,8 +204,8 @@
 BUILDSOURCES = $(libgtk2hs_a_BUILDSOURCES)
 
 .hs.o: $(CONFIG_H)
-	if test -f .depend; then \
-	$(strip $(HC) -c $< -o $@ $($(NAME)_HCFLAGS) -i$(VPATH) \
+	if test -f $(DEPDIR)$(NAME).dep; then \
+	  $(strip $(HC) -c $< -o $@ $($(NAME)_HCFLAGS) -i$(VPATH) \
 	  $(addprefix -package ,$($(NAME)_PACKAGEDEPS)) \
 	  $(addprefix -package-name ,$($(NAME)_PACKAGE)) \
 	  $(addprefix '-\#include<,$(addsuffix >',$(CONFIG_H) \
@@ -212,13 +214,21 @@
 	; else \
 	  $(MAKE) $(AM_MAKEFLAGS) NAME="$(NAME)" $($(NAME)_BUILDSOURCES) \
 	  && \
-	  $(strip $(HC) -M $(addprefix -optdep,-f .depend) \
+	  $(strip $(HC) -M $(addprefix -optdep,-f $(DEPDIR)$(NAME).dep) \
 	  $($(NAME)_HCFLAGS) -i$(VPATH) \
 	  $(addprefix -package ,$($(NAME)_PACKAGEDEPS)) \
 	  $(addprefix '-\#include<,$(addsuffix >',$(CONFIG_H) \
 	  $($(NAME)_EXTRA_HFILES))) \
 	  $(AM_CPPFLAGS) $($(NAME)_EXTRA_CPPFLAGS) $($(NAME)_CPPFLAGS) \
 	  $($(NAME)_HSFILES)) \
+	  && \
+	  $(strip $(HC) --make $($(NAME)_TOPLEVEL) \
+	  $($(NAME)_HCFLAGS) -i$(VPATH) \
+	  $(addprefix -package ,$($(NAME)_PACKAGEDEPS)) \
+	  $(addprefix -package-name ,$($(NAME)_PACKAGE)) \
+	  $(addprefix '-\#include<,$(addsuffix >',$(CONFIG_H) \
+	  $($(NAME)_EXTRA_HFILES))) \
+	  $(AM_CPPFLAGS) $($(NAME)_EXTRA_CPPFLAGS) $($(NAME)_CPPFLAGS))\
 	; fi
 
 .o.hi:
@@ -235,7 +245,7 @@
 	$(addprefix -C,$($(NAME)_CFLAGS) $($(NAME)_CPPFLAGS)) \
 	--precomp=$($(NAME)_PRECOMP) $($(NAME)_HEADER))
 
-.chspp.chs: $(CONFIG_H)
+.chs.cpp.chs: $(CONFIG_H)
 	$(strip $(HSCPP) $(AM_CPPFLAGS) \
 	$($(NAME)_EXTRA_CPPFLAGS) $($(NAME)_CPPFLAGS) \
 	$($(NAME)_EXTRA_CFLAGS) $($(NAME)_CFLAGS) \
@@ -259,7 +269,8 @@
 	-i$(VPATH) --precomp=$($(NAME)_PRECOMP) -o $@ $<)
 	$(CHSDEPEND) -i$(VPATH) $<
 
--include .depend *.dep
+
+-include $(DEPDIR)*.dep
 
 
 #	$(ECHO) no header file associated with $@

Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.230
retrieving revision 1.231
diff -u -d -r1.230 -r1.231
--- ChangeLog	25 Oct 2004 08:49:39 -0000	1.230
+++ ChangeLog	27 Oct 2004 13:21:37 -0000	1.231
@@ -1,3 +1,13 @@
+2004-10-27  Axel Simon <A....@ke...>
+
+	* mk/mkDepend.in: Redirect dependencies into .dep/ directory.
+	
+	* Makefile.am: Now builds libgtk2hs.a. Managed to define rule to
+	turn .chs.cpp into .chs, hence renamed all files that need to be
+	pre-processed.
+
+	* gtk/*/*.chspp: Renamed to .chs.cpp
+	
 2004-10-25  Axel Simon <A....@ke...>
 
 	* configure.ac: Don't update mk/config.mk.in which no longer

[Gtk2hs-commit] gtk2hs/gtk/windows FileChooserDialog.chs.cpp,NONE,1.1 Window.chs.cpp,NONE,1.1 FileChooserDialog.chspp,1.1,NONE Window.chspp,1.1,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/windows
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24829/gtk/windows

Added Files:
	FileChooserDialog.chs.cpp Window.chs.cpp 
Removed Files:
	FileChooserDialog.chspp Window.chspp 
Log Message:
Enhance makefile so that it builds the library. Changed .chspp to .chs.cpp in
all pre-processed chs files. Build with ghc --make the first time and with
ghc -c on incremental changes.


--- FileChooserDialog.chspp DELETED ---

--- NEW FILE: Window.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Window
--
--  Author : Manuel M. T. Chakravarty, Axel Simon
--          
--  Created: 27 April 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:43 $
--
--  Copyright (c) 2001 Manuel M. T. Chakravarty, 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.
--
-- |
--
-- TODO
--
-- * missing but possibly useful methods are commented out
--      
module Window(
  Window,
  WindowClass,
  castToWindow,
  windowNew,
  windowSetTitle,
  windowSetResizable,
  windowGetResizable,
--  windowAddAccelGroup, 
--  windowRemoveAccelGroup,
  windowActivateFocus,
  windowActivateDefault,
  windowSetModal,
  windowSetDefaultSize,
--  windowSetGeometryHints,
#ifndef DISABLE_DEPRECATED
  windowSetPolicy,
#endif
  windowSetPosition,
  WindowPosition(..),
  windowSetTransientFor,
  windowSetDestroyWithParent,
-- windowListToplevels,
-- windowAddMnemonic,
-- windowRemoveMnemonic,
-- windowSetMnemonicModifier,
  windowDeiconify,
  windowIconify,
  windowMaximize,
  windowUnmaximize,
  windowSetDecorated,
-- windowSetDecorationsHint,
  windowSetFrameDimensions,
-- windowSetFunctionHint,
  windowSetRole,
  windowStick,
  windowUnstick,
  onFrameEvent,
  afterFrameEvent,
  onSetFocus,
  afterSetFocus
  ) where

import Monad	(liftM)
import FFI

import Enums	(WindowType(WindowToplevel), WindowPosition(..))
import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}
import Events	(Event, marshalEvent)

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

-- methods

-- | Create a new window of the given type.
--
windowNew :: IO Window
windowNew = makeNewObject mkWindow $ liftM castPtr $
  {#call window_new#} ((fromIntegral.fromEnum) WindowToplevel)

-- | set the title string of the given window
--
windowSetTitle :: WindowClass w => w -> String -> IO ()
windowSetTitle w str = 
  withUTFString str ({#call window_set_title#} (toWindow w))

-- | Sets whether the user can resize a window.
--
-- * Windows are user resizable by default.
--
windowSetResizable :: WindowClass w => w -> Bool -> IO ()
windowSetResizable w res = 
  {#call window_set_resizable#} (toWindow w) (fromBool res)

-- | Retrieve the value set by
-- 'windowSetResizable'.
--
windowGetResizable :: WindowClass w => w -> IO Bool
windowGetResizable w = liftM toBool $ 
  {#call unsafe window_get_resizable#} (toWindow w)

-- | dunno
--
windowActivateFocus :: WindowClass w => w -> IO Bool
windowActivateFocus w = 
  liftM toBool $ {#call window_activate_focus#} (toWindow w)

-- | dunno
--
windowActivateDefault :: WindowClass w => w -> IO Bool
windowActivateDefault w = 
  liftM toBool $ {#call window_activate_default#} (toWindow w)

#ifndef DISABLE_DEPRECATED
{-# DEPRECATED windowSetPolicy "Use windowSetResizable instead." #-}
-- windowSetPolicy: set the window policy
--
windowSetPolicy :: WindowClass w => w -> Bool -> Bool -> Bool -> IO ()
windowSetPolicy w shrink grow auto = {#call window_set_policy#} 
  (toWindow w) (fromBool shrink) (fromBool grow) (fromBool auto)
#endif

-- | make a window application modal
--
windowSetModal :: WindowClass w => w -> Bool -> IO ()
windowSetModal w m = {#call window_set_modal#} (toWindow w) (fromBool m)

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

-- | set the window position policy
--
windowSetPosition :: WindowClass w => w -> WindowPosition -> IO ()
windowSetPosition w pos = 
  {#call window_set_position#} (toWindow w) ((fromIntegral.fromEnum) pos)

-- | set transient window
--
windowSetTransientFor :: (WindowClass win, WindowClass parent) => win ->
                         parent -> IO ()
windowSetTransientFor w p = 
  {#call window_set_transient_for#} (toWindow w) (toWindow p)

-- | destory transient window with parent
--
windowSetDestroyWithParent :: WindowClass w => w -> Bool -> IO ()
windowSetDestroyWithParent w b = 
  {#call window_set_destroy_with_parent#} (toWindow w) (fromBool b)

-- | restore the window
--
windowDeiconify :: WindowClass w => w -> IO ()
windowDeiconify w = {#call window_deiconify#} (toWindow w)

-- | minimize the window
--
windowIconify :: WindowClass w => w -> IO ()
windowIconify w = {#call window_iconify#} (toWindow w)

-- | maximize the window
--
windowMaximize :: WindowClass w => w -> IO ()
windowMaximize w = {#call window_maximize#} (toWindow w)

-- | unmaximize the window
--
windowUnmaximize :: WindowClass w => w -> IO ()
windowUnmaximize w = {#call window_unmaximize#} (toWindow w)

-- | remove the border
--
windowSetDecorated :: WindowClass w => w -> Bool -> IO ()
windowSetDecorated w b =
  {#call window_set_decorated#} (toWindow w) (fromBool b)

-- | set border widths
--
windowSetFrameDimensions :: WindowClass w => w -> Int -> Int -> Int -> Int ->
                            IO ()
windowSetFrameDimensions w left top right bottom =
 {#call window_set_frame_dimensions#} (toWindow w) (fromIntegral left)
 (fromIntegral top) (fromIntegral right) (fromIntegral bottom)

-- | set role (additional window name for the WM)
--
windowSetRole :: WindowClass w => w -> String -> IO ()
windowSetRole w str = 
  withUTFString str ({#call window_set_role#} (toWindow w))

-- | show the window on every workspace
--
windowStick :: WindowClass w => w -> IO ()
windowStick w = {#call window_stick#} (toWindow w)

-- | do not show the window on every workspace
--
windowUnstick :: WindowClass w => w -> IO ()
windowUnstick w = {#call window_unstick#} (toWindow w)

-- signals

-- | 
--
onFrameEvent, afterFrameEvent :: WindowClass w => w -> (Event -> IO Bool) ->
                                 IO (ConnectId w)
onFrameEvent = connect_BOXED__BOOL "frame_event" marshalEvent False
afterFrameEvent = connect_BOXED__BOOL "frame_event" marshalEvent True

-- | 
--
onSetFocus, afterSetFocus :: (WindowClass w, WidgetClass foc) => w ->
                             (foc -> IO ()) -> IO (ConnectId w)
onSetFocus = connect_OBJECT__NONE "set_focus" False
afterSetFocus = connect_OBJECT__NONE "set_focus" True




--- Window.chspp DELETED ---

--- NEW FILE: FileChooserDialog.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) entry Widget FileChooserDialog
--
--  Author : Duncan Coutts
--  Created: 24 April 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- The file chooser dialog and widget is a replacement
-- for the old "FileSel"ection dialog. It provides a better user
-- interface and an improved API.
--
-- * This is the dialog variant of the "FileChooser"
--
-- * Added in GTK+ 2.4
--
module FileChooserDialog (
#if GTK_CHECK_VERSION(2,4,0)
  FileChooserDialogClass,
  FileChooserDialog,
  fileChooserDialogNew,
  fileChooserDialogNewWithBackend
#endif
) where

#if GTK_CHECK_VERSION(2,4,0)

import Monad (liftM, when)
import Maybe (isJust, fromJust)
import FFI
{#import Hierarchy#}
{#import FileChooser#}
import GObject (objectNew)
import Object (makeNewObject)
import Window
import Dialog
import GValue
import StoreValue

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

-- The FileChooserDialog implements the FileChooser interface
-- which we model in Haskell as another instance decleration
instance FileChooserClass FileChooserDialog

fileChooserDialogNew
  :: Maybe String            -- ^ Title of the dialog (or default)
  -> Maybe Window            -- ^ Transient parent of the dialog (or none)
  -> FileChooserAction       -- ^ Open or save mode for the dialog
  -> [(String, ResponseId)]  -- ^ Buttons and their response codes
  -> IO FileChooserDialog
fileChooserDialogNew title parent action buttons =
  internalFileChooserDialogNew title parent action buttons Nothing


fileChooserDialogNewWithBackend
  :: Maybe String              -- ^ Title of the dialog (or default)
  -> Maybe Window              -- ^ Transient parent of the dialog (or none)
  -> FileChooserAction         -- ^ Open or save mode for the dialog
  -> [(String, ResponseId)]    -- ^ Buttons and their response codes
  -> String                    -- ^ The name of the filesystem backend to use
  -> IO FileChooserDialog
fileChooserDialogNewWithBackend title parent action buttons backend =
  internalFileChooserDialogNew title parent action buttons (Just backend)
  

-- Annoyingly, the constructor for FileChooserDialog uses varargs so we can't
-- call it using the Haskell FFI. The GTK people do not consider this an api
-- bug, see <http://bugzilla.gnome.org/show_bug.cgi?id=141004>
-- The solution is to call objectNew and add the buttons manually.

internalFileChooserDialogNew ::
  Maybe String ->           -- Title of the dialog (or default)
  Maybe Window ->           -- Transient parent of the dialog (or none)
  FileChooserAction ->      -- Open or save mode for the dialog
  [(String, ResponseId)] -> -- Buttons and their response codes
  Maybe String ->           -- The name of the backend to use (optional)
  IO FileChooserDialog
internalFileChooserDialogNew title parent action buttons backend = do
  objType <- {# call unsafe gtk_file_chooser_dialog_get_type #}
  dialog <-makeNewObject mkFileChooserDialog $ liftM castPtr $
           if (isJust backend)
             then with (GVstring backend) $ \backendGValue ->
                  objectNew objType [("file-system-backend", backendGValue)]
             else objectNew objType []
  when (isJust title)
       (dialog `windowSetTitle` fromJust title)
  when (isJust parent)
       (dialog `windowSetTransientFor` fromJust parent)
  dialog `fileChooserSetAction` action
  mapM_ (\(btnName, btnResponse) ->
          dialogAddButton dialog btnName btnResponse) buttons
  return dialog

#endif

[Gtk2hs-commit] gtk2hs/gtk/multiline TextIter.chs.cpp,NONE,1.1 TextTag.chs.cpp,NONE,1.1 TextIter.chspp,1.1,NONE TextTag.chspp,1.1,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/multiline
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24829/gtk/multiline

Added Files:
	TextIter.chs.cpp TextTag.chs.cpp 
Removed Files:
	TextIter.chspp TextTag.chspp 
Log Message:
Enhance makefile so that it builds the library. Changed .chspp to .chs.cpp in
all pre-processed chs files. Build with ghc --make the first time and with
ghc -c on incremental changes.


--- NEW FILE: TextIter.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) TextIter TextBuffer
--
--  Author : Axel Simon
--          
--  Created: 23 February 2002
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:42 $
--
--  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.
--
-- |
--
-- An iterator is an abstract datatype representing a pointer into a 
-- 'TextBuffer'.
--
-- * The following functions do not make sense due to Haskell's wide character
--   representation of Unicode:
--     gtk_text_iter_get_line_index
--     gtk_text_iter_get_visible_line_index
--     gtk_text_iter_get_bytes_in_line
--     gtk_text_iter_set_line_index
--     gtk_text_iter_set_visible_line_index
--
-- * The functions gtk_text_iter_in_range and gtk_text_iter_order are not bound
--   because they are only convenience functions which can replaced by calls
--   to textIterCompare.
--
-- * All offsets are counted from 0.
--
-- TODO
--
-- * Bind the following function when GSList is bound:
--     gtk_text_iter_get_marks
--     gtk_text_iter_get_toggled_tags
--     gtk_text_iter_get_tags
--
-- * Bind the following functions when we are sure about anchors 
--   (see 'TextBuffer'):
--     gtk_text_iter_get_anchor
--
-- * Bind TextAttribute functions when I am clear how to model them. 
--     gtk_text_iter_get_attribute
--
-- * Forward exceptions in the two callback functions.
--
module TextIter(
  TextIter(TextIter),
  mkTextIter,
  makeEmptyTextIter,	-- for internal use only
  textIterGetBuffer,
  textIterCopy,
  textIterGetOffset,
  textIterGetLine,
  textIterGetLineOffset,
  textIterGetVisibleLineOffset,
  textIterGetChar,
  textIterGetSlice,
  textIterGetText,
  textIterGetVisibleSlice,
  textIterGetVisibleText,
  textIterGetPixbuf,
  textIterBeginsTag,
  textIterEndsTag,
  textIterTogglesTag,
  textIterHasTag,
  textIterEditable,
  textIterCanInsert,
  textIterStartsWord,
  textIterEndsWord,
  textIterInsideWord,
  textIterStartsLine,
  textIterEndsLine,
  textIterStartsSentence,
  textIterEndsSentence,
  textIterInsideSentence,
  textIterIsCursorPosition,
  textIterGetCharsInLine,
  textIterIsEnd,
  textIterIsStart,
  textIterForwardChar,
  textIterBackwardChar,
  textIterForwardChars,
  textIterBackwardChars,
  textIterForwardLine,
  textIterBackwardLine,
  textIterForwardLines,
  textIterBackwardLines,
  textIterForwardWordEnds,
  textIterBackwardWordStarts,
  textIterForwardWordEnd,
  textIterBackwardWordStart,
  textIterForwardCursorPosition,
  textIterBackwardCursorPosition,
  textIterForwardCursorPositions,
  textIterBackwardCursorPositions,
  textIterForwardSentenceEnds,
  textIterBackwardSentenceStarts,
  textIterForwardSentenceEnd,
  textIterBackwardSentenceStart,
  textIterSetOffset,
  textIterSetLine,
  textIterSetLineOffset,
  textIterSetVisibleLineOffset,
  textIterForwardToEnd,
  textIterForwardToLineEnd,
  textIterForwardToTagToggle,
  textIterBackwardToTagToggle,
  textIterForwardFindChar,
  textIterBackwardFindChar,
  textIterForwardSearch,
  textIterBackwardSearch,
  textIterEqual,
  textIterCompare
  ) where

import Monad	(liftM)
import Maybe	(fromMaybe)
import Char	(chr)
import FFI
import GObject	(makeNewGObject)
{#import Hierarchy#}
{#import Signal#}
import Structs  (textIterSize)
import Enums	(TextSearchFlags, Flags(fromFlags))

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

-- methods

{#pointer *TextIter foreign newtype #}

-- Create a TextIter from a pointer.
--
mkTextIter :: Ptr TextIter -> IO TextIter
mkTextIter iterPtr = liftM TextIter $ 
  newForeignPtr iterPtr (text_iter_free iterPtr)

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&gtk_text_iter_free"
  text_iter_free' :: FinalizerPtr TextIter

text_iter_free :: Ptr TextIter -> FinalizerPtr TextIter
text_iter_free _ = text_iter_free'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gtk_text_iter_free"
  text_iter_free :: Ptr TextIter -> IO ()

#else

foreign import ccall "gtk_text_iter_free" unsafe
  text_iter_free :: Ptr TextIter -> IO ()

#endif

-- Allocate memory to be filled with a TextIter.
--
makeEmptyTextIter :: IO TextIter
makeEmptyTextIter = do
  iterPtr <- mallocBytes textIterSize
  liftM TextIter $ newForeignPtr iterPtr (text_iter_free iterPtr)

-- | Return the 'TextBuffer' this iterator
-- is associated with.
--
textIterGetBuffer :: TextIter -> IO TextBuffer
textIterGetBuffer ti = makeNewGObject mkTextBuffer $
  {#call unsafe text_iter_get_buffer#} ti

-- | Copy the iterator.
--
textIterCopy :: TextIter -> IO TextIter
textIterCopy ti = do
  iterPtr <- {#call unsafe text_iter_copy#} ti
  liftM TextIter $ newForeignPtr iterPtr (text_iter_free iterPtr)

-- | Extract the offset relative to the beginning of
-- the buffer.
--
textIterGetOffset :: TextIter -> IO Int
textIterGetOffset ti = liftM fromIntegral $
  {#call unsafe text_iter_get_offset#} ti

-- | Extract the line of the buffer.
--
textIterGetLine :: TextIter -> IO Int
textIterGetLine ti = liftM fromIntegral $
  {#call unsafe text_iter_get_line#} ti

-- | Extract the offset relative to the beginning
-- of the line.
--
textIterGetLineOffset :: TextIter -> IO Int
textIterGetLineOffset ti = liftM fromIntegral $
  {#call unsafe text_iter_get_line_offset#} ti

-- | Extract the offset relative to the
-- beginning of the line skipping invisible parts of the line.
--
textIterGetVisibleLineOffset :: TextIter -> IO Int
textIterGetVisibleLineOffset ti = liftM fromIntegral $
  {#call unsafe text_iter_get_visible_line_offset#} ti

-- | Return the character at this iterator.
--
textIterGetChar :: TextIter -> IO (Maybe Char)
textIterGetChar ti = do
  (res::Int) <- liftM fromIntegral $ {#call unsafe text_iter_get_char#} ti
  return $ if res==0 then Nothing else Just (chr res)

-- | Return the text in a given range.
--
-- * Pictures (and other objects) are represented by 0xFFFC.
--
textIterGetSlice :: TextIter -> TextIter -> IO String
textIterGetSlice end start = do
  cStr <- {#call text_iter_get_slice#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- | Return the text in a given range.
--
-- * Pictures (and other objects) are stripped form the output.
--
textIterGetText :: TextIter -> TextIter -> IO String
textIterGetText start end = do
  cStr <- {#call text_iter_get_text#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- | Return the visible text in a given range.
--
-- * Pictures (and other objects) are represented by 0xFFFC.
--
textIterGetVisibleSlice :: TextIter -> TextIter -> IO String
textIterGetVisibleSlice start end = do
  cStr <- {#call text_iter_get_visible_slice#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- | Return the visible text in a given range.
--
-- * Pictures (and other objects) are stripped form the output.
--
textIterGetVisibleText :: TextIter -> TextIter -> IO String
textIterGetVisibleText start end = do
  cStr <- {#call text_iter_get_visible_text#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- | Get the 'Pixbuf' under the iterator.
--
textIterGetPixbuf :: TextIter -> IO (Maybe Pixbuf)
textIterGetPixbuf it = do
  pbPtr <- {#call unsafe text_iter_get_pixbuf#} it
  if pbPtr==nullPtr then return Nothing else liftM Just $
    makeNewGObject mkPixbuf (return pbPtr)


-- | Query whether a 'TextIter' is at the
-- start of a 'TextTag'.
--
textIterBeginsTag :: TextIter -> TextTag -> IO Bool
textIterBeginsTag ti tt = liftM toBool $
  {#call unsafe text_iter_begins_tag#} ti tt


-- | Query whether a 'TextIter' is at the end
-- of a 'TextTag'.
--
textIterEndsTag :: TextIter -> TextTag -> IO Bool
textIterEndsTag ti tt = liftM toBool $
  {#call unsafe text_iter_ends_tag#} ti tt

-- | Query if the 'TextIter' is at the
-- beginning or the end of a 'TextTag'.
--
textIterTogglesTag :: TextIter -> TextTag -> IO Bool
textIterTogglesTag ti tt = liftM toBool $
  {#call unsafe text_iter_toggles_tag#} ti tt

-- | Check if 'TextIter' is within a range
-- tagged with tag.
--
textIterHasTag :: TextIter -> TextTag -> IO Bool
textIterHasTag ti tt = liftM toBool $
  {#call unsafe text_iter_has_tag#} ti tt

-- | Check if 'TextIter' is within an
-- editable region.
--
-- * If no tags that affect editability are attached to the current position
--   @def@ will be returned.
--
-- * This function cannot be used to decide whether text can be inserted at
--   'TextIter'. Use the 'textIterCanInsert' function for
--   this purpose.
--
textIterEditable :: TextIter -> Bool -> IO Bool
textIterEditable ti def = liftM toBool $ 
  {#call unsafe text_iter_editable#} ti (fromBool def)

-- | Check if new text can be inserted at
-- 'TextIter'.
--
-- * Use 'textBufferInsertInteractive' if you want to insert text
--   depending on the current editable status.
--
textIterCanInsert :: TextIter -> Bool -> IO Bool
textIterCanInsert ti def = liftM toBool $ 
  {#call unsafe text_iter_can_insert#} ti (fromBool def)

-- | Determine if 'TextIter' begins a new
-- natural-language word.
--
textIterStartsWord :: TextIter -> IO Bool
textIterStartsWord ti = liftM toBool $ {#call unsafe text_iter_starts_word#} ti


-- | Determine if 'TextIter' ends a new
-- natural-language word.
--
textIterEndsWord :: TextIter -> IO Bool
textIterEndsWord ti = liftM toBool $ {#call unsafe text_iter_ends_word#} ti

-- | Determine if 'TextIter' is inside a
-- word.
--
textIterInsideWord :: TextIter -> IO Bool
textIterInsideWord ti = liftM toBool $ {#call unsafe text_iter_inside_word#} ti

-- | Determine if 'TextIter' begins a new
-- line.
--
textIterStartsLine :: TextIter -> IO Bool
textIterStartsLine ti = liftM toBool $ {#call unsafe text_iter_starts_line#} ti

-- | Determine if 'TextIter' point to the
-- beginning of a line delimiter.
--
-- * Returns False if 'TextIter' points to the \n in a \r\n sequence.
--
textIterEndsLine :: TextIter -> IO Bool
textIterEndsLine ti = liftM toBool $ {#call unsafe text_iter_ends_line#} ti

-- | Determine if 'TextIter' starts a
-- sentence.
--
textIterStartsSentence :: TextIter -> IO Bool
textIterStartsSentence ti = liftM toBool $ 
  {#call unsafe text_iter_starts_sentence#} ti

-- | Determine if 'TextIter' ends a
-- sentence.
--
textIterEndsSentence :: TextIter -> IO Bool
textIterEndsSentence ti = liftM toBool $ 
  {#call unsafe text_iter_ends_sentence#} ti

-- | Determine if 'TextIter' is inside
-- a sentence.
--
textIterInsideSentence :: TextIter -> IO Bool
textIterInsideSentence ti = liftM toBool $ 
  {#call unsafe text_iter_inside_sentence#} ti

-- | Determine if 'TextIter' is at a
-- cursor position.
--
textIterIsCursorPosition :: TextIter -> IO Bool
textIterIsCursorPosition ti = liftM toBool $ 
  {#call unsafe text_iter_is_cursor_position#} ti

-- | Return number of characters in this line.
--
-- * The return value includes delimiters.
--
textIterGetCharsInLine :: TextIter -> IO Int
textIterGetCharsInLine ti = liftM fromIntegral $
  {#call unsafe text_iter_get_chars_in_line#} ti

-- | Get the text attributes at the iterator.
--
-- * The @ta@ argument gives the default values if no specific 
--   attributes are set at that specific location.
--
-- * The function returns @Nothing@ if the text at the iterator has 
--   the same attributes.
textIterGetAttributes = undefined

-- | Determine if 'TextIter' is at the end of
-- the buffer.
--
textIterIsEnd :: TextIter -> IO Bool
textIterIsEnd ti = liftM toBool $ 
  {#call unsafe text_iter_is_end#} ti

-- | Determine if 'TextIter' is at the
-- beginning of the buffer.
--
textIterIsStart :: TextIter -> IO Bool
textIterIsStart ti = liftM toBool $ 
  {#call unsafe text_iter_is_start#} ti

-- | Move 'TextIter' forwards.
--
-- * Retuns True if the iterator is pointing to a character.
--
textIterForwardChar :: TextIter -> IO Bool
textIterForwardChar ti = liftM toBool $ 
  {#call unsafe text_iter_forward_char#} ti

-- | Move 'TextIter' backwards.
--
-- * Retuns True if the movement was possible.
--
textIterBackwardChar :: TextIter -> IO Bool
textIterBackwardChar ti = liftM toBool $ 
  {#call unsafe text_iter_backward_char#} ti

-- | Move 'TextIter' forwards by
-- @n@ characters.
--
-- * Retuns True if the iterator is pointing to a new character (and False if
--   the iterator points to a picture or has not moved).
--
textIterForwardChars :: TextIter -> Int -> IO Bool
textIterForwardChars ti n = liftM toBool $ 
  {#call unsafe text_iter_forward_chars#} ti (fromIntegral n)

-- | Move 'TextIter' backwards by
-- @n@ characters.
--
-- * Retuns True if the iterator is pointing to a new character (and False if
--   the iterator points to a picture or has not moved).
--
textIterBackwardChars :: TextIter -> Int -> IO Bool
textIterBackwardChars ti n = liftM toBool $ 
  {#call unsafe text_iter_backward_chars#} ti (fromIntegral n)


-- | Move 'TextIter' forwards.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If 'TextIter' is on the first line, it will be moved to the
--   beginning of the buffer.
--
textIterForwardLine :: TextIter -> IO Bool
textIterForwardLine ti = liftM toBool $ 
  {#call unsafe text_iter_forward_line#} ti

-- | Move 'TextIter' backwards.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If 'TextIter' is on the first line, it will be moved to the end
--   of the buffer.
--
textIterBackwardLine :: TextIter -> IO Bool
textIterBackwardLine ti = liftM toBool $ 
  {#call unsafe text_iter_backward_line#} ti


-- | Move 'TextIter' forwards by
-- @n@ lines.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If 'TextIter' is on the first line, it will be moved to the
--   beginning of the buffer.
--
-- * @n@ can be negative.
--
textIterForwardLines :: TextIter -> Int -> IO Bool
textIterForwardLines ti n = liftM toBool $ 
  {#call unsafe text_iter_forward_lines#} ti (fromIntegral n)

-- | Move 'TextIter' backwards by
-- @n@ lines.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If 'TextIter' is on the first line, it will be moved to the end
--   of the buffer.
--
-- * @n@ can be negative.
--
textIterBackwardLines :: TextIter -> Int -> IO Bool
textIterBackwardLines ti n = liftM toBool $ 
  {#call unsafe text_iter_backward_lines#} ti (fromIntegral n)

-- | Move 'TextIter' forwards by
-- @n@ word ends.
--
-- * Retuns True if the iterator is pointing to a new word end.
--
textIterForwardWordEnds :: TextIter -> Int -> IO Bool
textIterForwardWordEnds ti n = liftM toBool $ 
  {#call unsafe text_iter_forward_word_ends#} ti (fromIntegral n)

-- | Move 'TextIter' backwards by
-- @n@ word beginnings.
--
-- * Retuns True if the iterator is pointing to a new word start.
--
textIterBackwardWordStarts :: TextIter -> Int -> IO Bool
textIterBackwardWordStarts ti n = liftM toBool $ 
  {#call unsafe text_iter_backward_word_starts#} ti (fromIntegral n)

-- | Move 'TextIter' forwards to the
-- next word end.
--
-- * Retuns True if the iterator has moved to a new word end.
--
textIterForwardWordEnd :: TextIter -> IO Bool
textIterForwardWordEnd ti = liftM toBool $ 
  {#call unsafe text_iter_forward_word_end#} ti

-- | Move 'TextIter' backwards to
-- the next word beginning.
--
-- * Retuns True if the iterator has moved to a new word beginning.
--
textIterBackwardWordStart :: TextIter -> IO Bool
textIterBackwardWordStart ti = liftM toBool $ 
  {#call unsafe text_iter_backward_word_start#} ti

-- | Move 'TextIter' forwards to
-- the next cursor position.
--
-- * Some characters are composed of two Unicode codes. This function ensures
--   that 'TextIter' does not point inbetween such double characters.
--
-- * Returns True if 'TextIter' moved and points to a character (not
--   to an object).
--
textIterForwardCursorPosition :: TextIter -> IO Bool
textIterForwardCursorPosition ti = liftM toBool $
  {#call unsafe text_iter_forward_cursor_position#} ti

-- | Move 'TextIter' backwards
-- to the next cursor position.
--
-- * Some characters are composed of two Unicode codes. This function ensures
--   that 'TextIter' does not point inbetween such double characters.
--
-- * Returns True if 'TextIter' moved and points to a character (not
--   to an object).
--
textIterBackwardCursorPosition :: TextIter -> IO Bool
textIterBackwardCursorPosition ti = liftM toBool $
  {#call unsafe text_iter_backward_cursor_position#} ti

-- | Move 'TextIter' forwards
-- by @n@ cursor positions.
--
-- * Returns True if 'TextIter' moved and points to a character (not
--   to an object).
--
textIterForwardCursorPositions :: TextIter -> Int -> IO Bool
textIterForwardCursorPositions ti n = liftM toBool $ 
  {#call unsafe text_iter_forward_cursor_positions#} ti (fromIntegral n)

-- | Move 'TextIter' backwards
-- by @n@ cursor positions.
--
-- * Returns True if 'TextIter' moved and points to a character (not
--   to an object).
--
textIterBackwardCursorPositions :: TextIter -> Int -> IO Bool
textIterBackwardCursorPositions ti n = liftM toBool $ 
  {#call unsafe text_iter_backward_cursor_positions#} ti (fromIntegral n)


-- | Move 'TextIter' forwards by
-- @n@ sentence ends.
--
-- * Retuns True if the iterator is pointing to a new sentence end.
--
textIterForwardSentenceEnds :: TextIter -> Int -> IO Bool
textIterForwardSentenceEnds ti n = liftM toBool $ 
  {#call unsafe text_iter_forward_sentence_ends#} ti (fromIntegral n)

-- | Move 'TextIter' backwards
-- by @n@ sentence beginnings.
--
-- * Retuns True if the iterator is pointing to a new sentence start.
--
textIterBackwardSentenceStarts :: TextIter -> Int -> IO Bool
textIterBackwardSentenceStarts ti n = liftM toBool $ 
  {#call unsafe text_iter_backward_sentence_starts#} ti (fromIntegral n)

-- | Move 'TextIter' forwards to
-- the next sentence end.
--
-- * Retuns True if the iterator has moved to a new sentence end.
--
textIterForwardSentenceEnd :: TextIter -> IO Bool
textIterForwardSentenceEnd ti = liftM toBool $ 
  {#call unsafe text_iter_forward_sentence_end#} ti

-- | Move 'TextIter' backwards
-- to the next sentence beginning.
--
-- * Retuns True if the iterator has moved to a new sentence beginning.
--
textIterBackwardSentenceStart :: TextIter -> IO Bool
textIterBackwardSentenceStart ti = liftM toBool $ 
  {#call unsafe text_iter_backward_sentence_start#} ti

-- | Set 'TextIter' to an offset within the
-- buffer.
--
textIterSetOffset :: TextIter -> Int -> IO ()
textIterSetOffset ti n = 
  {#call unsafe text_iter_set_offset#} ti (fromIntegral n)

-- | Set 'TextIter' to a line within the
-- buffer.
--
textIterSetLine :: TextIter -> Int -> IO ()
textIterSetLine ti n = 
  {#call unsafe text_iter_set_line#} ti (fromIntegral n)

-- | Set 'TextIter' to an offset within
-- the line.
--
textIterSetLineOffset :: TextIter -> Int -> IO ()
textIterSetLineOffset ti n = 
  {#call unsafe text_iter_set_line_offset#} ti (fromIntegral n)

-- | Set 'TextIter' to an visible
-- character within the line.
--
textIterSetVisibleLineOffset :: TextIter -> Int -> IO ()
textIterSetVisibleLineOffset ti n = 
  {#call unsafe text_iter_set_visible_line_offset#} ti (fromIntegral n)

-- | Moves 'TextIter' to the end of the
-- buffer.
--
textIterForwardToEnd :: TextIter -> IO ()
textIterForwardToEnd ti = {#call unsafe text_iter_forward_to_end#} ti

-- | Moves 'TextIter' to the end of
-- the line.
--
-- * Returns True if 'TextIter' moved to a new location which is not
--   the buffer end iterator.
--
textIterForwardToLineEnd :: TextIter -> IO Bool
textIterForwardToLineEnd ti = liftM toBool $
  {#call unsafe text_iter_forward_to_line_end#} ti

-- | Moves 'TextIter' forward to
-- the next change of a 'TextTag'.
--
-- * If Nothing is supplied, any 'TextTag' will be matched.
--
-- * Returns True if there was a tag toggle after 'TextIter'.
--
textIterForwardToTagToggle :: TextIter -> Maybe TextTag -> IO Bool
textIterForwardToTagToggle ti tt = liftM toBool $
  {#call unsafe text_iter_forward_to_tag_toggle#} ti 
    (fromMaybe (mkTextTag nullForeignPtr) tt)

-- | Moves 'TextIter' backward to
-- the next change of a 'TextTag'.
--
-- * If Nothing is supplied, any 'TextTag' will be matched.
--
-- * Returns True if there was a tag toggle before 'TextIter'.
--
textIterBackwardToTagToggle :: TextIter -> Maybe TextTag -> IO Bool
textIterBackwardToTagToggle ti tt = liftM toBool $
  {#call unsafe text_iter_backward_to_tag_toggle#} ti 
    (fromMaybe (mkTextTag nullForeignPtr) tt)

-- Setup a callback for a predicate function.
--
type TextCharPredicateCB = Char -> Bool

{#pointer TextCharPredicate#}

foreign import ccall "wrapper" mkTextCharPredicate ::
  ({#type gunichar#} -> Ptr () -> {#type gboolean#}) -> IO TextCharPredicate

-- | Move 'TextIter' forward until a
-- predicate function returns True.
--
-- * If @pred@ returns True before @limit@ is reached, the
--   search is stopped and the return value is True.
--
-- * If @limit@ is Nothing, the search stops at the end of the buffer.
--
textIterForwardFindChar :: TextIter -> (Char -> Bool) -> Maybe TextIter ->
                           IO Bool
textIterForwardFindChar ti pred limit = do
  fPtr <- mkTextCharPredicate (\c _ -> fromBool $ pred (chr (fromIntegral c)))
  res <- liftM toBool $ {#call text_iter_forward_find_char#} 
    ti fPtr nullPtr (fromMaybe (TextIter nullForeignPtr) limit)
  freeHaskellFunPtr fPtr
  return res

-- | Move 'TextIter' backward until a
-- predicate function returns True.
--
-- * If @pred@ returns True before @limit@ is reached, the
--   search is stopped and the return value is True.
--
-- * If @limit@ is Nothing, the search stops at the end of the buffer.
--
textIterBackwardFindChar :: TextIter -> (Char -> Bool) -> Maybe TextIter ->
                            IO Bool
textIterBackwardFindChar ti pred limit = do
  fPtr <- mkTextCharPredicate (\c _ -> fromBool $ pred (chr (fromIntegral c)))
  res <- liftM toBool $ {#call text_iter_backward_find_char#} 
    ti fPtr nullPtr (fromMaybe (TextIter nullForeignPtr) limit)
  freeHaskellFunPtr fPtr
  return res

-- | Search forward for a specific string.
--
-- * If specified, the last character which is tested against that start of
--   the search pattern will be @limit@.
--
-- * 'TextSearchFlags' may be empty.
--
-- * Returns the start and end position of the string found.
--
textIterForwardSearch :: TextIter -> String -> [TextSearchFlags] ->
                         Maybe TextIter -> IO (Maybe (TextIter, TextIter))
textIterForwardSearch ti str flags limit = do
  start  <- makeEmptyTextIter
  end <- makeEmptyTextIter
  found <- liftM toBool $ withUTFString str $ \cStr ->
    {#call unsafe text_iter_forward_search#} ti cStr 
    ((fromIntegral.fromFlags) flags) start end 
    (fromMaybe (TextIter nullForeignPtr) limit)
  return $ if found then Just (start,end) else Nothing

-- | Search backward for a specific string.
--
-- * If specified, the last character which is tested against that start of
--   the search pattern will be @limit@.
--
-- * 'TextSearchFlags' my be empty.
--
-- * Returns the start and end position of the string found.
--
textIterBackwardSearch :: TextIter -> String -> [TextSearchFlags] ->
                          Maybe TextIter -> IO (Maybe (TextIter, TextIter))
textIterBackwardSearch ti str flags limit = do
  start  <- makeEmptyTextIter
  end <- makeEmptyTextIter
  found <- liftM toBool $ withUTFString str $ \cStr ->
    {#call unsafe text_iter_backward_search#} ti cStr 
    ((fromIntegral.fromFlags) flags) start end 
    (fromMaybe (TextIter nullForeignPtr) limit)
  return $ if found then Just (start,end) else Nothing

-- | Compare two 'TextIter' for equality.
--
-- * 'TextIter' could be in class Eq and Ord if there is a guarantee
--   that each iterator is copied before it is modified in place. This is done
--   the next abstraction layer.
--
textIterEqual :: TextIter -> TextIter -> IO Bool
textIterEqual ti2 ti1 = liftM toBool $ {#call unsafe text_iter_equal#} ti1 ti2

-- | Compare two 'TextIter'.
--
-- * 'TextIter' could be in class Eq and Ord if there is a guarantee
--   that each iterator is copied before it is modified in place. This could
--   be done the next abstraction layer.
--
textIterCompare :: TextIter -> TextIter -> IO Ordering
textIterCompare ti2 ti1 = do
  res <- {#call unsafe text_iter_compare#} ti1 ti2
  return $ case res of
    (-1)   -> LT
    0	   -> EQ
    1	   -> GT



--- NEW FILE: TextTag.chs.cpp ---
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget TextTag
--
--  Author : Duncan Coutts
--  Created: 4 August 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- A tag that can be applied to text in a "TextBuffer".
--
-- TODO
--
-- * accessor functions for TextAttributes

module TextTag(
  TextTag,
  TextTagClass,
  castToTextTag,
  TagName,
  textTagNew,
  textTagSetPriority,
  textTagGetPriority,
  TextAttributes(..),
  textAttributesNew,
  makeNewTextAttributes,  --internal
  ) where

import Monad	(liftM)
import FFI

import GObject	(makeNewGObject)
{#import Hierarchy#}
{#import Signal#}

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

type TagName = String

-- TextTag methods

-- | Creates a 'TextTag'.
--
textTagNew :: TagName -> IO TextTag
textTagNew name =
  withCString name $ \strPtr ->
  makeNewGObject mkTextTag $ {#call unsafe text_tag_new#} strPtr

-- | Get the tag priority.
--
textTagGetPriority :: TextTagClass obj => obj -> IO Int
textTagGetPriority obj = liftM fromIntegral $
  {#call unsafe text_tag_get_priority#} (toTextTag obj)

-- | Sets the priority of a 'TextTag'.
--
-- Valid priorities are start at 0 and go to one less than
-- 'textTagTableGetSize'. Each tag in a table has a unique priority; setting the
-- priority of one tag shifts the priorities of all the other tags in the table
-- to maintain a unique priority for each tag. Higher priority tags \"win\" if
-- two tags both set the same text attribute. When adding a tag to a tag table,
-- it will be assigned the highest priority in the table by default; so normally
-- the precedence of a set of tags is the order in which they were added to the
-- table, or created with 'textBufferCreateTag', which adds the tag to the
-- buffer's table automatically.
--
textTagSetPriority :: TextTagClass obj => obj -> Int -> IO ()
textTagSetPriority obj priority =
  {#call text_tag_set_priority#} (toTextTag obj) (fromIntegral priority)


-- TextAttributes methods

{#pointer * TextAttributes foreign newtype#}

-- | Creates a 'TextAttributes', which describes a set of properties on some
-- text.
--
textAttributesNew :: IO TextAttributes
textAttributesNew =
  {#call unsafe text_attributes_new#} >>= makeNewTextAttributes

makeNewTextAttributes :: Ptr TextAttributes -> IO TextAttributes
makeNewTextAttributes ptr =
  liftM TextAttributes $ newForeignPtr ptr (text_attributes_unref ptr)

#if __GLASGOW_HASKELL__>=600
                                                                                
foreign import ccall unsafe "&gtk_text_attributes_unref"
  text_attributes_unref' :: FinalizerPtr TextAttributes
                                                                                
text_attributes_unref :: Ptr TextAttributes -> FinalizerPtr TextAttributes
text_attributes_unref _ = text_attributes_unref'
                                                                                
#elif __GLASGOW_HASKELL__>=504
                                                                                
foreign import ccall unsafe "gtk_text_attributes_unref"
  text_attributes_unref :: Ptr TextAttributes -> IO ()
                                                                                
#else
                                                                                
foreign import ccall "gtk_text_attributes_unref" unsafe
  text_attributes_unref :: Ptr TextAttributes -> IO ()
                                                                                
#endif

--- TextTag.chspp DELETED ---

--- TextIter.chspp DELETED ---

[Gtk2hs-commit] gtk2hs/mk chsDepend.in,1.5,1.6

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/mk
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24829/mk

Modified Files:
	chsDepend.in 
Log Message:
Enhance makefile so that it builds the library. Changed .chspp to .chs.cpp in
all pre-processed chs files. Build with ghc --make the first time and with
ghc -c on incremental changes.


Index: chsDepend.in
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/mk/chsDepend.in,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- chsDepend.in	21 Jul 2002 16:07:18 -0000	1.5
+++ chsDepend.in	27 Oct 2004 13:21:43 -0000	1.6
@@ -6,6 +6,8 @@
 # in the colon-separated search path <searchPath>.
 SED=@SED@;
 GREP=@GREP@;
+DEPDIR=@DEPDIR@;
+DEPDIRSLASH=`if test -n "$DEPDIR"; then echo $DEPDIR/; fi`;
 
 SEARCHPATH=.;
 
@@ -20,6 +22,7 @@
 for FULLNAME in $@; do
   FULLNAMEDEP=`echo "$FULLNAME" | $SED 's/\.chs/.dep/'`;
   FULLNAMEHS=`echo "$FULLNAME" | $SED 's/\.chs/.hs/'`;
+  TARGETNAMEDEP=$DEPDIRSLASH`basename $FULLNAMEDEP`;
   if test -f "$FULLNAME"; then
     DEPS=`$GREP "{#import" $FULLNAME 2> /dev/null | $SED 's/^{#import \([a-zA-Z1-9]*\)#}.*/\1.chs/'`;
     #echo Looking for dependent files: $DEPS
@@ -38,8 +41,8 @@
       IFS=$OLDIFS;
     done;
     if test -n "$DEPNAMES"; then
-      echo "$FULLNAMEDEP :" > $FULLNAMEDEP
-      echo "$FULLNAMEHS : $DEPNAMES" >> $FULLNAMEDEP;
+      echo "$FULLNAMEDEP :" > $TARGETNAMEDEP;
+      echo "$FULLNAMEHS : $DEPNAMES" >> $TARGETNAMEDEP;
     fi;
     echo Writing dependency information for $FULLNAME
   else

[Gtk2hs-commit] gtk2hs/gtk/pango PangoTypes.chs.cpp,NONE,1.1 PangoTypes.chspp,1.1,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/pango
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24829/gtk/pango

Added Files:
	PangoTypes.chs.cpp 
Removed Files:
	PangoTypes.chspp 
Log Message:
Enhance makefile so that it builds the library. Changed .chspp to .chs.cpp in
all pre-processed chs files. Build with ghc --make the first time and with
ghc -c on incremental changes.


--- PangoTypes.chspp DELETED ---

--- NEW FILE: PangoTypes.chs.cpp ---
--  GIMP Toolkit (GTK) - pango non-GObject types PangoTypes
--
--  Author : Axel Simon
--          
--  Created: 9 Feburary 2003
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:42 $
--
--  Copyright (c) 1999..2003 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.
--
-- |
--
-- Define types used in Pango which are not derived from GObject.
--
module PangoTypes(
  LayoutIter(LayoutIter),
  layout_iter_free,
  LayoutLine(LayoutLine),
  mkLayoutLine
  ) where

import Monad    (liftM)
import FFI

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

-- entry PangoLayout

-- | An iterator to examine a layout.
--
{#pointer *PangoLayoutIter as LayoutIter foreign newtype #}

-- | A single line in a 'PangoLayout'.
--
{#pointer *PangoLayoutLine as LayoutLine foreign newtype #}

mkLayoutLine :: Ptr LayoutLine -> IO LayoutLine
mkLayoutLine llPtr = do
  pango_layout_line_ref llPtr
  liftM LayoutLine $ newForeignPtr llPtr (pango_layout_line_unref llPtr)


#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&pango_layout_iter_free"
  layout_iter_free' :: FinalizerPtr LayoutIter

layout_iter_free :: Ptr LayoutIter -> FinalizerPtr LayoutIter
layout_iter_free _ = layout_iter_free'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "pango_layout_iter_free"
  layout_iter_free :: Ptr LayoutIter -> IO ()

#else

foreign import ccall "pango_layout_iter_free" unsafe
  layout_iter_free :: Ptr LayoutIter -> IO ()

#endif

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&pango_layout_line_unref"
  pango_layout_line_unref' :: FinalizerPtr LayoutLine

pango_layout_line_unref :: Ptr LayoutLine -> FinalizerPtr LayoutLine
pango_layout_line_unref _ = pango_layout_line_unref'

#elif __GLASGOW_HASKELL__>=504

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

#else

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

#endif

#if __GLASGOW_HASKELL__>=504

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

#else

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

#endif

[Gtk2hs-commit] gtk2hs/gtk/misc Calendar.chs.cpp,NONE,1.1 EventBox.chs.cpp,NONE,1.1 FileChooserWidget.chs.cpp,NONE,1.1 Tooltips.chs.cpp,NONE,1.1 Calendar.chspp,1.1,NONE EventBox.chspp,1.1,NONE FileChooserWidget.chspp,1.1,NONE Tooltips.chspp,1.1,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/misc
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24829/gtk/misc

Added Files:
	Calendar.chs.cpp EventBox.chs.cpp FileChooserWidget.chs.cpp 
	Tooltips.chs.cpp 
Removed Files:
	Calendar.chspp EventBox.chspp FileChooserWidget.chspp 
	Tooltips.chspp 
Log Message:
Enhance makefile so that it builds the library. Changed .chspp to .chs.cpp in
all pre-processed chs files. Build with ghc --make the first time and with
ghc -c on incremental changes.


--- NEW FILE: EventBox.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget EventBox
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:42 $
--
--  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.
--
-- |
--
-- This container can be used to receive 'Event's for a widget
-- that has no window on its own.
--
-- TODO
--
-- * check: Is this widget useful?
--
module EventBox(
  EventBox,
  EventBoxClass,
  castToEventBox,
  eventBoxNew
#if GTK_CHECK_VERSION(2,4,0)
 ,eventBoxSetVisibleWindow,
  eventBoxGetVisibleWindow,
  eventBoxSetAboveChild,
  eventBoxGetAboveChild
#endif
  ) where

import Monad	(liftM)
import FFI

import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}

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

-- methods

-- | Create a new 'EventBox'.
--
eventBoxNew :: IO EventBox
eventBoxNew  = makeNewObject mkEventBox $ 
  liftM castPtr {#call unsafe event_box_new#}

#if GTK_CHECK_VERSION(2,4,0)
-- | Set whether the event box uses a visible or invisible child window. The
-- default is to use visible windows. The C documentation for details of what
-- difference this makes.
--
eventBoxSetVisibleWindow :: EventBox -> Bool -> IO ()
eventBoxSetVisibleWindow ebox visible =
  {#call event_box_set_visible_window#} ebox (fromBool visible)

-- | Returns whether the event box has a visible window.
--
eventBoxGetVisibleWindow :: EventBox -> IO Bool
eventBoxGetVisibleWindow ebox =
  liftM toBool $ {#call unsafe event_box_get_visible_window#} ebox

-- | Set whether the event box window is positioned above the windows of its
-- child, as opposed to below it. 
--
-- * If the window is above, all events inside the event box will go to the
-- event box. If the window is below, events in windows of child widgets will
-- first got to that widget, and then to its parents.
--
eventBoxSetAboveChild :: EventBox -> Bool -> IO ()
eventBoxSetAboveChild ebox above =
  {#call event_box_set_above_child#} ebox (fromBool above)

-- | Returns whether the event box window is above or below the windows of its
-- child. See 'eventBoxSetAboveChild' for details.
--
eventBoxGetAboveChild :: EventBox -> IO Bool
eventBoxGetAboveChild ebox =
  liftM toBool $ {#call unsafe event_box_get_above_child#} ebox
#endif

--- EventBox.chspp DELETED ---

--- FileChooserWidget.chspp DELETED ---

--- Calendar.chspp DELETED ---

--- NEW FILE: FileChooserWidget.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) entry Widget FileChooserWidget
--
--  Author : Duncan Coutts
--  Created: 24 April 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
--  The file chooser dialog and widget is a replacement
--  for the old "FileSel"ection dialog. It provides a better user
--  interface and an improved API.
--
-- * This is the widget variant of the "FileChooser"
--
-- * Added in GTK+ 2.4
--
module FileChooserWidget (
#if GTK_CHECK_VERSION(2,4,0)
  FileChooserWidgetClass,
  FileChooserWidget,
  FileChooserAction,
  fileChooserWidgetNew,
  fileChooserWidgetNewWithBackend,
#endif
) where

#if GTK_CHECK_VERSION(2,4,0)

import Monad (liftM)
import FFI
import Object
{#import Hierarchy#}
{#import FileChooser#} (FileChooserAction)

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

-- The FileChooserWidget implements the FileChooser interface
-- which we model in Haskell as another instance decleration
instance FileChooserClass FileChooserWidget

fileChooserWidgetNew ::  FileChooserAction -> IO FileChooserWidget
fileChooserWidgetNew action =
  makeNewObject mkFileChooserWidget $ liftM castPtr $
  {# call unsafe gtk_file_chooser_widget_new #}
    (fromIntegral $ fromEnum action)

fileChooserWidgetNewWithBackend ::  FileChooserAction -> String -> IO FileChooserWidget
fileChooserWidgetNewWithBackend action backend =
  makeNewObject mkFileChooserWidget $ liftM castPtr $
  withCString backend $ \strPtr ->
  {# call unsafe gtk_file_chooser_widget_new_with_backend #}
    (fromIntegral $ fromEnum action) strPtr

#endif

--- NEW FILE: Calendar.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Calendar
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:42 $
--
--  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.
--
-- |
--
-- This widget shows a calendar.
--
module Calendar(
  Calendar,
  CalendarClass,
  castToCalendar,
  calendarNew,
  calendarSelectMonth,
  calendarSelectDay,
  calendarMarkDay,
  calendarUnmarkDay,
  calendarClearMarks,
  calendarDisplayOptions,
#if GTK_CHECK_VERSION(2,4,0)
  calendarSetDisplayOptions,
  calendarGetDisplayOptions,
#endif
  calendarGetDate,
  onDaySelected,
  afterDaySelected,
  onDaySelectedDoubleClick,
  afterDaySelectedDoubleClick,
  onMonthChanged,
  afterMonthChanged,
  onNextMonth,
  afterNextMonth,
  onNextYear,
  afterNextYear,
  onPrevMonth,
  afterPrevMonth,
  onPrevYear,
  afterPrevYear
  ) where

import Monad	(liftM)
import FFI

import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}
import Enums	(CalendarDisplayOptions(..), fromFlags, toFlags)

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

-- methods

-- | Create a new calendar widget.
--
-- * No sensible date will be set.
--
calendarNew :: IO Calendar
calendarNew  = makeNewObject mkCalendar $ 
  liftM castPtr {#call unsafe calendar_new#}

-- | Flip the page to a month , 0 is January,.., 11
-- is December.
--
-- * Returns True if the operation succeeded.
--
calendarSelectMonth :: CalendarClass c => c -> Int -> Int -> IO Bool
calendarSelectMonth cal month year = liftM toBool $
  {#call calendar_select_month#} (toCalendar cal) (fromIntegral month)
  (fromIntegral year)

-- | Shift to a day, counted form 1 to 31 (depending
-- on the month of course).
--
calendarSelectDay :: CalendarClass c => c -> Int -> IO ()
calendarSelectDay cal day = 
  {#call calendar_select_day#} (toCalendar cal) (fromIntegral day)

-- | Mark (select) a day in the current month.
--
-- * Returns True if the argument was within bounds and the day was previously
--   deselected.
--
calendarMarkDay :: CalendarClass c => c -> Int -> IO Bool
calendarMarkDay cal day = liftM toBool $
  {#call calendar_mark_day#} (toCalendar cal) (fromIntegral day)

-- | Unmark (deselect) a day in the current month.
--
-- * Returns True if the argument was within bounds and the day was previously
--   selected.
--
calendarUnmarkDay :: CalendarClass c => c -> Int -> IO Bool
calendarUnmarkDay cal day = liftM toBool $
  {#call calendar_unmark_day#} (toCalendar cal) (fromIntegral day)

-- | Unmark every day in the current page.
--
calendarClearMarks :: CalendarClass c => c -> IO ()
calendarClearMarks cal = {#call calendar_clear_marks#} (toCalendar cal)

#if GTK_CHECK_VERSION(2,4,0)
-- | Specifies how the calendar should be displayed.
--
calendarSetDisplayOptions :: CalendarClass c => c
                          -> [CalendarDisplayOptions] -> IO ()
calendarSetDisplayOptions cal opts =
  {#call calendar_set_display_options#} (toCalendar cal)
    ((fromIntegral.fromFlags) opts)

-- | Returns the current display options for the calendar.
--
calendarGetDisplayOptions :: CalendarClass c => c
                          -> IO [CalendarDisplayOptions]
calendarGetDisplayOptions cal = liftM (toFlags.fromIntegral) $
  {#call calendar_get_display_options#} (toCalendar cal)

-- | Depreciaded, use 'calendarSetDisplayOptions'.
--
calendarDisplayOptions :: CalendarClass c => c
                       -> [CalendarDisplayOptions] -> IO ()
calendarDisplayOptions = calendarSetDisplayOptions
#else

-- | Specifies how the calendar should be displayed.
--
calendarDisplayOptions :: CalendarClass c => c -> [CalendarDisplayOptions] ->
                          IO ()
calendarDisplayOptions cal opts = {#call calendar_display_options#}
  (toCalendar cal) ((fromIntegral.fromFlags) opts)
#endif

-- | Retrieve the currently selected date.
--
-- * Returns (year, month, day) of the selection.
--
calendarGetDate :: CalendarClass c => c -> IO (Int,Int,Int)
calendarGetDate cal = alloca $ \yearPtr -> alloca $ \monthPtr -> 
  alloca $ \dayPtr -> do
    {#call unsafe calendar_get_date#} (toCalendar cal) yearPtr monthPtr dayPtr
    year  <- liftM fromIntegral $ peek yearPtr
    month <- liftM fromIntegral $ peek monthPtr
    day	  <- liftM fromIntegral	$ peek dayPtr
    return (year,month,day)

-- | Freeze the calender for several update operations.
--
calendarFreeze :: CalendarClass c => c -> IO a -> IO a
calendarFreeze cal update = do
  {#call unsafe calendar_freeze#} (toCalendar cal)
  res <- update
  {#call calendar_thaw#} (toCalendar cal)
  return res

-- signals

-- | Emitted when a day was selected.
--
onDaySelected, afterDaySelected :: CalendarClass c => c -> IO () ->
                                   IO (ConnectId c)
onDaySelected = connect_NONE__NONE "day-selected" False
afterDaySelected = connect_NONE__NONE "day-selected" True

-- | Emitted when a day received a
-- double click.
--
onDaySelectedDoubleClick, afterDaySelectedDoubleClick :: CalendarClass c => 
                                                         c -> IO () ->
                                                         IO (ConnectId c)
onDaySelectedDoubleClick = 
  connect_NONE__NONE "day-selected-double-click" False
afterDaySelectedDoubleClick = 
  connect_NONE__NONE "day-selected-double-click" True

-- | The month changed.
--
onMonthChanged, afterMonthChanged :: CalendarClass c => c -> IO () ->
                                     IO (ConnectId c)
onMonthChanged = connect_NONE__NONE "month-changed" False
afterMonthChanged = connect_NONE__NONE "month-changed" True

-- | The next month was selected.
--
onNextMonth, afterNextMonth :: CalendarClass c => c -> IO () ->
                               IO (ConnectId c)
onNextMonth = connect_NONE__NONE "next-month" False
afterNextMonth = connect_NONE__NONE "next-month" True

-- | The next year was selected.
--
onNextYear, afterNextYear :: CalendarClass c => c -> IO () -> IO (ConnectId c)
onNextYear = connect_NONE__NONE "next-year" False
afterNextYear = connect_NONE__NONE "next-year" True

-- | The previous month was selected.
--
onPrevMonth, afterPrevMonth :: CalendarClass c => c -> IO () ->
                               IO (ConnectId c)
onPrevMonth = connect_NONE__NONE "prev-month" False
afterPrevMonth = connect_NONE__NONE "prev-month" True

-- | The previous year was selected.
--
onPrevYear, afterPrevYear :: CalendarClass c => c -> IO () -> IO (ConnectId c)
onPrevYear = connect_NONE__NONE "prev-year" False
afterPrevYear = connect_NONE__NONE "prev-year" True

  

--- Tooltips.chspp DELETED ---

--- NEW FILE: Tooltips.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Tooltips
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:42 $
--
--  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.
--
-- |
--
-- Tooltips are the messages that appear next to a widget when the mouse
-- pointer is held over it for a short amount of time. They are especially
-- helpful for adding more verbose descriptions of things such as buttons
-- in a toolbar. 
--
-- An individual tooltip belongs to a group of tooltips. A group is created
-- with a call to 'tooltipsNew'. Every tooltip in the group can 
-- then be turned off with a call to 'tooltipsDisable' and enabled with 
-- 'tooltipsEnable'.
--
#ifndef DISABLE_DEPRECATED
-- The length of time the user must keep the mouse over a widget before the tip
-- is shown, can be altered with 'tooltipsSetDelay'. This is set on a 'per group
-- of tooltips' basis.
--
#endif
-- To assign a tip to a particular widget, 'tooltipsSetTip' is used.
--
-- To associate 'Tooltips' to a widget it is has to have its own 'DrawWindow'.
-- Otherwise the widget must be set into an 'EventBox'.
--
module Tooltips(
  Tooltips,
  TooltipsClass,
  castToTooltips,
  tooltipsNew,
  tooltipsEnable,
  tooltipsDisable,
#ifndef DISABLE_DEPRECATED
  tooltipsSetDelay,
#endif
  tooltipsSetTip,
  tooltipsDataGet
  ) where

import Monad	(liftM)
import FFI

import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}

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

-- methods

-- | Create a new goup of 'Tooltips'.
--
tooltipsNew :: IO Tooltips
tooltipsNew  = makeNewObject mkTooltips $ 
  liftM castPtr {#call unsafe tooltips_new#}

-- | Display the help the 'Tooltips' group
-- provides.
--
tooltipsEnable :: TooltipsClass t => t -> IO ()
tooltipsEnable t = {#call unsafe tooltips_enable#} (toTooltips t)

-- | Disable 'Tooltips' group.
--
-- * Causes all tooltips in tooltips to become inactive. Any widgets that have
--   tips associated with that group will no longer display their tips until
--   they are enabled again with 'tooltipsEnable'.
--
tooltipsDisable :: TooltipsClass t => t -> IO ()
tooltipsDisable t = {#call unsafe tooltips_disable#} (toTooltips t)

#ifndef DISABLE_DEPRECATED
-- | Sets the time between the user moving the mouse
-- over a widget and the widget's tooltip appearing.
--
-- * The @time@ parameter is in ms.
--
tooltipsSetDelay :: TooltipsClass t => t -> Int -> IO ()
tooltipsSetDelay t time = {#call unsafe tooltips_set_delay#}
  (toTooltips t) (fromIntegral time)
#endif

-- | Adds a tooltip containing the message tipText to
-- the specified GtkWidget.
--
-- * The @tipPrivate@ parameter is meant to give a thorough
--   explaination. This might someday be accessible to a questionmark cursor
--   (like MS Windows).
--
tooltipsSetTip :: (TooltipsClass t, WidgetClass w) => t -> w -> String ->
                  String -> IO ()
tooltipsSetTip t w tipText tipPrivate = 
  withUTFString tipPrivate $ \priPtr ->
  withUTFString tipText $ \txtPtr ->
  {#call unsafe tooltips_set_tip#} (toTooltips t) (toWidget w) txtPtr priPtr

{#pointer * TooltipsData#}

-- | Retrieves any 'Tooltips' previously associated with the given widget.
--
tooltipsDataGet :: WidgetClass w => w -> IO (Maybe (Tooltips, String, String))
tooltipsDataGet w = do
  tipDataPtr <- {#call unsafe tooltips_data_get#} (toWidget w)
  if tipDataPtr == nullPtr
    then return Nothing
    else do --next line is a hack, tooltips struct member is at offset 0
	   tooltips <- makeNewObject mkTooltips (return $ castPtr tipDataPtr)
           tipText  <- {#get TooltipsData->tip_text#} tipDataPtr
                   >>= peekUTFString
           tipPrivate <- {#get TooltipsData->tip_private#} tipDataPtr
                     >>= peekUTFString
           return $ Just $ (tooltips, tipText, tipPrivate)

[Gtk2hs-commit] gtk2hs/gtk/layout Alignment.chs.cpp,NONE,1.1 Expander.chs.cpp,NONE,1.1 Notebook.chs.cpp,NONE,1.1 Alignment.chspp,1.1,NONE Expander.chspp,1.1,NONE Notebook.chspp,1.1,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/layout
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24829/gtk/layout

Added Files:
	Alignment.chs.cpp Expander.chs.cpp Notebook.chs.cpp 
Removed Files:
	Alignment.chspp Expander.chspp Notebook.chspp 
Log Message:
Enhance makefile so that it builds the library. Changed .chspp to .chs.cpp in
all pre-processed chs files. Build with ghc --make the first time and with
ghc -c on incremental changes.


--- NEW FILE: Notebook.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Notebook
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:40 $
--
--  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.
--
-- |
--
-- This widget can display several pages of widgets. Each page can be selected
-- by a tab at the top of the widget. It is useful in dialogs where a lot of
-- information has to be displayed.
--
-- TODO
--
-- * The signals focus-tab and select-page are not bound because it is unclear
--   what they mean. As far as I can see they are not emitted anywhere.
--
module Notebook(
  Notebook,
  NotebookClass,
  castToNotebook,
  notebookNew,
  notebookAppendPage,
  notebookAppendPageMenu,
  notebookPrependPage,
  notebookPrependPageMenu,
  notebookInsertPage,
  notebookInsertPageMenu,
  notebookRemovePage,
  notebookPageNum,
  notebookSetCurrentPage,
  notebookNextPage,
  notebookPrevPage,
  notebookReorderChild,
  PositionType(..),
  notebookSetTabPos,
  notebookGetTabPos,
  notebookSetShowTabs,
  notebookGetShowTabs,
  notebookSetShowBorder,
  notebookSetScrollable,
  notebookGetScrollable,
#ifndef DISABLE_DEPRECATED
  notebookSetTabBorder,
  notebookSetTabHBorder,
  notebookSetTabVBorder,
#endif
  notebookSetPopup,
  notebookGetCurrentPage,
  notebookSetMenuLabel,
  notebookGetMenuLabel,
  notebookSetMenuLabelText,
  notebookGetMenuLabelText,
  notebookGetNthPage,
#if GTK_CHECK_VERSION(2,2,0)
  notebookGetNPages,
#endif
  notebookGetTabLabel,
  notebookGetTabLabelText,
  Packing(..), PackType(..),
  notebookQueryTabLabelPacking,
  notebookSetTabLabelPacking,
#ifndef DISABLE_DEPRECATED
  notebookSetHomogeneousTabs,
#endif
  notebookSetTabLabel,
  notebookSetTabLabelText,
  onSwitchPage,
  afterSwitchPage
  ) where

import Monad	(liftM)
import Maybe	(maybe)
import FFI

import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}
import Label	(labelNew)
import Enums	(Packing(..), PackType(..), PositionType(..))

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

-- methods

-- | Create a new notebook.
--
notebookNew :: IO Notebook
notebookNew  = makeNewObject mkNotebook $ 
  liftM castPtr {#call unsafe notebook_new#}

#if GTK_CHECK_VERSION(2,4,0)
-- | Insert a new tab to the right of the existing tabs.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context menu is enabled, this name will also appear in the popup menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookAppendPageMenu'.
--
-- * Returns index (starting from 0) of the appended page in the notebook, or -1
-- if the function fails.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookAppendPage :: (NotebookClass nb, WidgetClass child) => nb
                   -> child   -- ^ Widget to use as the contents of the page
                   -> String  -- ^ Label for the page.
                   -> IO Int
notebookAppendPage nb child tabLabel = do
  tab <- labelNew (Just tabLabel)
  liftM fromIntegral $
    {#call notebook_append_page#} (toNotebook nb) (toWidget child) 
      (toWidget tab)

#else
-- | Insert a new tab to the right of the existing tabs.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context popup menu is enabled, this name will also appear in the menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookAppendPageMenu'.
--
-- * This function returns @Int@ in Gtk version 2.4.0 and later.
--
notebookAppendPage :: (NotebookClass nb, WidgetClass child) => nb
                   -> child   -- ^ Widget to use as the contents of the page
                   -> String  -- ^ Label for the page.
                   -> IO ()
notebookAppendPage nb child tabLabel = do
  tab <- labelNew (Just tabLabel)
  {#call notebook_append_page#} (toNotebook nb) (toWidget child) (toWidget tab)
#endif

#if GTK_CHECK_VERSION(2,4,0)
-- | Insert a new tab to the right of the existing tabs.
--
-- Like 'notebookAppendPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * Returns the index (starting from 0) of the appended page in the notebook,
-- or -1 if the function fails.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookAppendPageMenu :: (NotebookClass nb, WidgetClass child,
   WidgetClass tab, WidgetClass menu) => nb
  -> child  -- ^ Widget to use as the contents of the page
  -> tab    -- ^ Tab label widget for the page.
  -> menu   -- ^ Menu entry for this tab (usually a 'Label' widget).
  -> IO Int
notebookAppendPageMenu nb child tabWidget menuWidget = liftM fromIntegral $
  {#call notebook_append_page_menu#} (toNotebook nb) (toWidget child)
    (toWidget tabWidget) (toWidget menuWidget)

#else
-- | Insert a new tab to the right of the existing tabs.
--
-- Like 'notebookAppendPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * This function returns @Int@ in Gtk version 2.4.0 and later
--
notebookAppendPageMenu :: (NotebookClass nb, WidgetClass child,
   WidgetClass tab, WidgetClass menu) => nb
  -> child  -- ^ Widget to use as the contents of the page
  -> tab    -- ^ Tab label widget for the page.
  -> menu   -- ^ Menu entry for this tab (usually a 'Label' widget).
  -> IO ()
notebookAppendPageMenu nb child tabWidget menuWidget =
  {#call notebook_append_page_menu#} (toNotebook nb) (toWidget child)
    (toWidget tabWidget) (toWidget menuWidget)
#endif

#if GTK_CHECK_VERSION(2,4,0)
-- | Insert a new tab to the left of the existing tabs.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context menu is enabled, this name will also appear in the popup menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookPrependPageMenu'.
--
-- * Returns index (starting from 0) of the prepended page in the notebook, or -1
-- if the function fails.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookPrependPage :: (NotebookClass nb, WidgetClass child) => nb
                   -> child   -- ^ Widget to use as the contents of the page
                   -> String  -- ^ Label for the page.
                   -> IO Int
notebookPrependPage nb child tabLabel = do
  tab <- labelNew (Just tabLabel)
  liftM fromIntegral $
    {#call notebook_prepend_page#} (toNotebook nb) (toWidget child) 
      (toWidget tab)

#else
-- | Insert a new tab to the left of the existing tabs.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context popup menu is enabled, this name will also appear in the menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookPrependPageMenu'.
--
-- * This function returns @Int@ in Gtk version 2.4.0 and later.
--
notebookPrependPage :: (NotebookClass nb, WidgetClass child) => nb
                   -> child   -- ^ Widget to use as the contents of the page
                   -> String  -- ^ Label for the page.
                   -> IO ()
notebookPrependPage nb child tabLabel = do
  tab <- labelNew (Just tabLabel)
  {#call notebook_prepend_page#} (toNotebook nb) (toWidget child) 
    (toWidget tab)
#endif

#if GTK_CHECK_VERSION(2,4,0)
-- | Insert a new tab to the left of the existing tabs.
--
-- Like 'notebookPrependPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * Returns the index (starting from 0) of the prepended page in the notebook,
-- or -1 if the function fails.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookPrependPageMenu :: (NotebookClass nb, WidgetClass child,
   WidgetClass tab, WidgetClass menu) => nb
  -> child  -- ^ Widget to use as the contents of the page
  -> tab    -- ^ Tab label widget for the page.
  -> menu   -- ^ Menu entry for this tab (usually a 'Label' widget).
  -> IO Int
notebookPrependPageMenu nb child tabWidget menuWidget = liftM fromIntegral $
  {#call notebook_prepend_page_menu#} (toNotebook nb) (toWidget child)
    (toWidget tabWidget) (toWidget menuWidget)

#else
-- | Insert a new tab to the left of the existing tabs.
--
-- Like 'notebookPrependPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * This function returns @Int@ in Gtk version 2.4.0 and later
--
notebookPrependPageMenu :: (NotebookClass nb, WidgetClass child,
   WidgetClass tab, WidgetClass menu) => nb
  -> child  -- ^ Widget to use as the contents of the page
  -> tab    -- ^ Tab label widget for the page.
  -> menu   -- ^ Menu entry for this tab (usually a 'Label' widget).
  -> IO ()
notebookPrependPageMenu nb child tabWidget menuWidget =
  {#call notebook_prepend_page_menu#} (toNotebook nb) (toWidget child)
    (toWidget tabWidget) (toWidget menuWidget)
#endif

#if GTK_CHECK_VERSION(2,4,0)
-- | Insert a new tab at the specified position. That is between @pos@ and
-- @pos@+1, or -1 to append the page after all other pages.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context menu is enabled, this name will also appear in the popup menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookInsertPageMenu'.
--
-- * Returns index (starting from 0) of the inserted page in the notebook, or -1
-- if the function fails.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookInsertPage :: (NotebookClass nb, WidgetClass child) => nb
                   -> child  -- ^ Widget to use as the contents of the page
                   -> String -- ^ Label for the page.
                   -> Int    -- ^ Position for the new page.
                   -> IO Int
notebookInsertPage nb child tabLabel pos = do
  tab <- labelNew (Just tabLabel)
  liftM fromIntegral $
    {#call notebook_insert_page#} (toNotebook nb) (toWidget child) 
      (toWidget tab) (fromIntegral pos)

#else
-- | Insert a new tab at the specified position. That is between @pos@ and
-- @pos@+1, or -1 to append the page after all other pages.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context menu is enabled, this name will also appear in the popup menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookInsertPageMenu'.
--
-- * This function returns @Int@ in Gtk version 2.4.0 and later.
--
notebookInsertPage :: (NotebookClass nb, WidgetClass child) => nb
                   -> child  -- ^ Widget to use as the contents of the page
                   -> String -- ^ Label for the page.
                   -> Int    -- ^ Position for the new page.
                   -> IO ()
notebookInsertPage nb child tabLabel pos = do
  tab <- labelNew (Just tabLabel)
  {#call notebook_insert_page#} (toNotebook nb) (toWidget child) 
    (toWidget tab) (fromIntegral pos)
#endif

#if GTK_CHECK_VERSION(2,4,0)
-- | Insert a new tab at the specified position. That is between @pos@ and
-- @pos@+1, or -1 to append the page after all other pages.
--
-- Like 'notebookInsertPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * Returns the index (starting from 0) of the inserted page in the notebook,
-- or -1 if the function fails.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookInsertPageMenu ::(NotebookClass nb, WidgetClass child, 
   WidgetClass tab, WidgetClass menu) => nb
  -> child  -- ^ Widget to use as the contents of the page
  -> tab    -- ^ Tab label widget for the page.
  -> menu   -- ^ Menu entry for this tab (usually a 'Label' widget).
  -> Int    -- ^ Position for the new page.
  -> IO Int
notebookInsertPageMenu nb child tabWidget menuWidget pos = liftM fromIntegral $
  {#call notebook_insert_page_menu#} (toNotebook nb) (toWidget child)
    (toWidget tabWidget) (toWidget menuWidget) (fromIntegral pos)

#else
-- | Insert a new tab at the specified position. That is between @pos@ and
-- @pos@+1, or -1 to append the page after all other pages.
--
-- Like 'notebookInsertPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * This function returns @Int@ in Gtk version 2.4.0 and later
--
notebookInsertPageMenu ::(NotebookClass nb, WidgetClass child, 
   WidgetClass tab, WidgetClass menu) => nb
  -> child  -- ^ Widget to use as the contents of the page
  -> tab    -- ^ Tab label widget for the page.
  -> menu   -- ^ Menu entry for this tab (usually a 'Label' widget).
  -> Int    -- ^ Position for the new page.
  -> IO ()
notebookInsertPageMenu nb child tabWidget menuWidget pos =
  {#call notebook_insert_page_menu#} (toNotebook nb) (toWidget child)
    (toWidget tabWidget) (toWidget menuWidget) (fromIntegral pos)
#endif

-- | Remove a specific page from the notebook, counting from 0.
--
notebookRemovePage :: NotebookClass nb => nb -> Int -> IO ()
notebookRemovePage nb pos = 
  {#call notebook_remove_page#} (toNotebook nb) (fromIntegral pos)

-- | Query the page the child widget is contained in.
--
-- * The function returns the page number if the child was found, Nothing
--   otherwise.
--
notebookPageNum :: (NotebookClass nb, WidgetClass w) => nb -> w ->
                   IO (Maybe Int)
notebookPageNum nb child = 
  liftM (\page -> if page==(-1) then Nothing else Just (fromIntegral page)) $
  {#call unsafe notebook_page_num#} (toNotebook nb) (toWidget child)

-- | Move to the specified page of the notebook.
--
-- * If the position is out of range (e.g. negative) select the last page.
--
notebookSetCurrentPage :: NotebookClass nb => nb -> Int -> IO ()
notebookSetCurrentPage nb pos =
  {#call notebook_set_current_page#} (toNotebook nb) (fromIntegral pos)

-- | Move to the right neighbour of the current page.
--
-- * Nothing happens if there is no such page.
--
notebookNextPage :: NotebookClass nb => nb -> IO ()
notebookNextPage nb = {#call notebook_next_page#} (toNotebook nb)

-- | Move to the left neighbour of the current page.
--
-- * Nothing happens if there is no such page.
--
notebookPrevPage :: NotebookClass nb => nb -> IO ()
notebookPrevPage nb = {#call notebook_prev_page#} (toNotebook nb)

-- | Move a page withing the notebook.
--
notebookReorderChild :: (NotebookClass nb, WidgetClass w) => nb -> w -> Int ->
                        IO ()
notebookReorderChild nb child pos = {#call notebook_reorder_child#}
  (toNotebook nb) (toWidget child) (fromIntegral pos)

-- | Specify at which border the tabs should be drawn.
--
notebookSetTabPos :: NotebookClass nb => nb -> PositionType -> IO ()
notebookSetTabPos nb pt = {#call notebook_set_tab_pos#}
  (toNotebook nb) ((fromIntegral.fromEnum) pt)

-- | Gets the edge at which the tabs for switching pages in the notebook are
-- drawn.
--
notebookGetTabPos :: NotebookClass nb => nb -> IO PositionType
notebookGetTabPos nb = liftM (toEnum.fromIntegral) $
  {#call unsafe notebook_get_tab_pos#} (toNotebook nb)

-- | Show or hide the tabs of a notebook.
--
notebookSetShowTabs :: NotebookClass nb => nb -> Bool -> IO ()
notebookSetShowTabs nb showTabs = {#call notebook_set_show_tabs#}
  (toNotebook nb) (fromBool showTabs)

-- | Returns whether the tabs of the notebook are shown.
--
notebookGetShowTabs :: NotebookClass nb => nb -> IO Bool
notebookGetShowTabs nb =
  liftM toBool $ {#call unsafe notebook_get_show_tabs#} (toNotebook nb)

-- | In case the tabs are not shown, specify whether to draw a border around
-- the notebook.
--
notebookSetShowBorder :: NotebookClass nb => nb -> Bool -> IO ()
notebookSetShowBorder nb showBorder = {#call notebook_set_show_border#}
  (toNotebook nb) (fromBool showBorder)

-- | Returns whether a bevel will be drawn around the notebook pages.
--
notebookGetShowBorder :: NotebookClass nb => nb -> IO Bool
notebookGetShowBorder nb =
  liftM toBool $ {#call unsafe notebook_get_show_border#} (toNotebook nb)

-- | Set whether scroll bars will be added in case the notebook has too many
-- tabs to fit the widget size.
--
notebookSetScrollable :: NotebookClass nb => nb -> Bool -> IO ()
notebookSetScrollable nb scrollable = {#call unsafe notebook_set_scrollable#}
  (toNotebook nb) (fromBool scrollable)

-- | Returns whether the tab label area has arrows for scrolling.
--
notebookGetScrollable :: NotebookClass nb => nb -> IO Bool
notebookGetScrollable nb = liftM toBool $
  {#call unsafe notebook_get_scrollable#} (toNotebook nb)

#ifndef DISABLE_DEPRECATED
-- | Set the width of the borders of the tab labels.
--
-- * Sets both vertical and horizontal widths.
--
notebookSetTabBorder :: NotebookClass nb => nb -> Int -> IO ()
notebookSetTabBorder nb width = {#call notebook_set_tab_border#}
  (toNotebook nb) (fromIntegral width)

-- | Set the width of the borders of the tab labels.
--
-- * Sets horizontal widths.
--
notebookSetTabHBorder :: NotebookClass nb => nb -> Int -> IO ()
notebookSetTabHBorder nb width = {#call notebook_set_tab_hborder#}
  (toNotebook nb) (fromIntegral width)

-- | Set the width of the borders of the tab labels.
--
-- * Sets vertical widths.
--
notebookSetTabVBorder :: NotebookClass nb => nb -> Int -> IO ()
notebookSetTabVBorder nb width = {#call notebook_set_tab_vborder#}
  (toNotebook nb) (fromIntegral width)
#endif

-- | Enable or disable context menus with all tabs in it.
--
notebookSetPopup :: NotebookClass nb => nb -> Bool -> IO ()
notebookSetPopup nb enable = (if enable 
  then {#call notebook_popup_enable#} else {#call notebook_popup_disable#})
  (toNotebook nb)

-- | Query the currently selected page.
--
-- * Returns -1 if notebook has no pages.
--
notebookGetCurrentPage :: NotebookClass nb => nb -> IO Int
notebookGetCurrentPage nb = liftM fromIntegral $
  {#call unsafe notebook_get_current_page#} (toNotebook nb)

-- | Changes the menu label for the page containing the given child widget.
--
notebookSetMenuLabel :: (NotebookClass nb, WidgetClass ch, WidgetClass label)
                     => nb -> ch -> Maybe label -> IO ()
notebookSetMenuLabel nb child label =
  {#call notebook_set_menu_label#} (toNotebook nb) (toWidget child)
    (maybe (Widget nullForeignPtr) toWidget label)

-- | Extract the menu label from the given @child@.
--
-- * Returns Nothing if @child@ was not found.
--
notebookGetMenuLabel :: (NotebookClass nb, WidgetClass w) => nb -> w ->
                        IO (Maybe Label)
notebookGetMenuLabel nb child = do
  wPtr <- {#call unsafe notebook_get_menu_label#} 
    (toNotebook nb) (toWidget child)
  if wPtr==nullPtr then return Nothing else liftM Just $
    makeNewObject mkLabel $ return $ castPtr wPtr

-- | Creates a new label and sets it as the menu label of the given child
-- widget.
--
notebookSetMenuLabelText :: (NotebookClass nb, WidgetClass ch)
                         => nb -> ch -> String -> IO ()
notebookSetMenuLabelText nb child label =
  withUTFString label $ \labelPtr ->
  {#call notebook_set_menu_label_text#} (toNotebook nb)
    (toWidget child) labelPtr

-- | Retrieves the text of the menu label for the page containing the given
-- child widget.
--
notebookGetMenuLabelText :: (NotebookClass nb, WidgetClass ch)
                         => nb -> ch -> IO (Maybe String)
notebookGetMenuLabelText nb child = do
  labelPtr <- {#call unsafe notebook_get_menu_label_text#} (toNotebook nb)
    (toWidget child)
  maybePeek peekUTFString labelPtr

-- | Retrieve the child widget at the given position (starting from 0).
--
-- * Returns Nothing if the index is out of bounds.
--
notebookGetNthPage :: NotebookClass nb => nb -> Int -> IO (Maybe Widget)
notebookGetNthPage nb pos = do
  wPtr <- {#call unsafe notebook_get_nth_page#} 
    (toNotebook nb) (fromIntegral pos)
  if wPtr==nullPtr then return Nothing else liftM Just $
    makeNewObject mkWidget $ return wPtr

#if GTK_CHECK_VERSION(2,2,0)

-- | Get the number of pages in a notebook.
--
-- * Only available in Gtk 2.2 and higher.
--
notebookGetNPages :: NotebookClass nb => nb -> IO Int
notebookGetNPages nb = liftM fromIntegral $
  {#call unsafe notebook_get_n_pages#} (toNotebook nb)

#endif

-- | Extract the tab label from the given @child@.
--
-- * Nothing is returned if no tab label has specifically been set for the
-- child.
--
notebookGetTabLabel :: (NotebookClass nb, WidgetClass w) => nb -> w ->
                       IO (Maybe Widget)
notebookGetTabLabel nb child = do
  wPtr <- {#call unsafe notebook_get_tab_label#} 
    (toNotebook nb) (toWidget child)
  if wPtr==nullPtr then return Nothing else liftM Just $
    makeNewObject mkWidget $ return wPtr

-- | Retrieves the text of the tab label for the page containing the given child
-- widget.
--
notebookGetTabLabelText :: (NotebookClass nb, WidgetClass w) => nb -> w ->
                       IO (Maybe String)
notebookGetTabLabelText nb child = do
  labelPtr <- {#call unsafe notebook_get_tab_label_text#} (toNotebook nb)
    (toWidget child)
  maybePeek peekUTFString labelPtr

-- | Query the packing attributes of the given child.
--
notebookQueryTabLabelPacking :: (NotebookClass nb, WidgetClass w) => nb -> w ->
                                IO (Packing,PackType)
notebookQueryTabLabelPacking nb child = 
  alloca $ \expPtr -> alloca $ \fillPtr -> alloca $ \packPtr -> do
    {#call unsafe notebook_query_tab_label_packing#} (toNotebook nb)
      (toWidget child) expPtr fillPtr packPtr
    expand <- liftM toBool $ peek expPtr
    fill <- liftM toBool $ peek fillPtr
    pt <- liftM (toEnum.fromIntegral) $ peek packPtr
    return (if fill then PackGrow else 
             (if expand then PackRepel else PackNatural),
	    pt)

-- | Set the packing attributes of the given child.
--
notebookSetTabLabelPacking :: (NotebookClass nb, WidgetClass w) => nb -> w ->
                              Packing -> PackType -> IO ()
notebookSetTabLabelPacking nb child pack pt = 
  {#call notebook_set_tab_label_packing#} (toNotebook nb) (toWidget child)
    (fromBool $ pack/=PackNatural) (fromBool $ pack==PackGrow) 
    ((fromIntegral.fromEnum) pt)

#ifndef DISABLE_DEPRECATED
-- | Sets whether the tabs must have all the same size or not.
--
notebookSetHomogeneousTabs :: NotebookClass nb => nb -> Bool -> IO ()
notebookSetHomogeneousTabs nb hom = {#call notebook_set_homogeneous_tabs#}
  (toNotebook nb) (fromBool hom)
#endif

-- | Set a new tab label for a given page.
--
notebookSetTabLabel :: (NotebookClass nb, WidgetClass ch, WidgetClass tab) => 
                       nb -> ch -> tab -> IO ()
notebookSetTabLabel nb child tab = {#call notebook_set_tab_label#}
  (toNotebook nb) (toWidget child) (toWidget tab)

-- | Creates a new label and sets it as the tab label for the given page.
--
notebookSetTabLabelText :: (NotebookClass nb, WidgetClass ch) => 
                       nb -> ch -> String -> IO ()
notebookSetTabLabelText nb child label =
  withUTFString label $ \labelPtr ->
  {#call notebook_set_tab_label_text#} (toNotebook nb) (toWidget child) labelPtr


-- signals

-- | This signal is emitted when a new page is
-- selected.
--
onSwitchPage, afterSwitchPage :: NotebookClass nb => nb -> (Int -> IO ()) ->
                                 IO (ConnectId nb)
onSwitchPage nb fun = connect_BOXED_WORD__NONE "switch-page" 
		      (const $ return ()) False nb 
		      (\_ page -> fun (fromIntegral page))
afterSwitchPage nb fun = connect_BOXED_WORD__NONE "switch-page" 
			 (const $ return ()) True nb 
			 (\_ page -> fun (fromIntegral page))


 

--- Notebook.chspp DELETED ---

--- NEW FILE: Expander.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Expander
--
--  Author : Duncan Coutts
--  Created: 24 April 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- An Expander allows the user to hide or show its child by clicking on an
-- expander triangle similar to the triangles used in a TreeView.
--
-- Normally you use an expander as you would use any other descendant of GtkBin
-- you create the child widget and use containerAdd to add it to the expander.
-- When the expander is toggled, it will take care of showing and hiding the
-- child automatically.
--
-- * Added in GTK+ 2.4
--
module Expander (
#if GTK_CHECK_VERSION(2,4,0)
  Expander,
  ExpanderClass,
  expanderNew,
  expanderNewWithMnemonic,
  expanderSetExpanded,
  expanderGetExpanded,
  expanderSetSpacing,
  expanderGetSpacing,
  expanderSetLabel,
  expanderGetLabel,
  expanderSetUseUnderline,
  expanderGetUseUnderline,
  expanderSetUseMarkup,
  expanderGetUseMarkup,
  expanderSetLabelWidget,
  expanderGetLabelWidget,
  onActivate,
  afterActivate
#endif
) where

#if GTK_CHECK_VERSION(2,4,0)

import Monad (liftM)
import FFI
import Object
{#import Hierarchy#}
import Signal

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

expanderNew :: String -> IO Expander
expanderNew label = 
 makeNewObject mkExpander $ liftM castPtr $
 withUTFString label $ \strPtr ->
 {# call gtk_expander_new #} strPtr

expanderNewWithMnemonic :: String -> IO Expander
expanderNewWithMnemonic label =
 makeNewObject mkExpander $ liftM castPtr $
 withUTFString label $ \strPtr -> 
 {# call gtk_expander_new_with_mnemonic #} strPtr

expanderSetExpanded :: Expander -> Bool -> IO ()
expanderSetExpanded expander expanded = 
 {# call gtk_expander_set_expanded #} expander (fromBool expanded)

expanderGetExpanded :: Expander -> IO Bool
expanderGetExpanded expander = liftM toBool $
 {# call gtk_expander_get_expanded #} expander

expanderSetSpacing :: Expander -> Int -> IO ()
expanderSetSpacing expander spacing = 
 {# call gtk_expander_set_spacing #} expander (fromIntegral spacing)

expanderGetSpacing :: Expander -> IO Int
expanderGetSpacing expander = liftM fromIntegral $
 {# call gtk_expander_get_spacing #} expander

expanderSetLabel :: Expander -> String -> IO ()
expanderSetLabel expander label =
 withUTFString label $ \strPtr ->
 {# call gtk_expander_set_label #} expander strPtr

expanderGetLabel :: Expander -> IO String
expanderGetLabel expander = do
 strPtr <- {# call gtk_expander_get_label #} expander
 peekUTFString strPtr

expanderSetUseUnderline :: Expander -> Bool -> IO ()
expanderSetUseUnderline expander useUnderline = 
 {# call gtk_expander_set_use_underline #} expander (fromBool useUnderline)

expanderGetUseUnderline :: Expander -> IO Bool
expanderGetUseUnderline expander = liftM toBool $
 {# call gtk_expander_get_use_underline #} expander

expanderSetUseMarkup :: Expander -> Bool -> IO ()
expanderSetUseMarkup expander useMarkup = 
 {# call gtk_expander_set_use_markup #} expander (fromBool useMarkup)

expanderGetUseMarkup :: Expander -> IO Bool
expanderGetUseMarkup expander = liftM toBool $
 {# call gtk_expander_get_use_markup #} expander

expanderSetLabelWidget :: WidgetClass widget => Expander -> widget -> IO ()
expanderSetLabelWidget expander widget = 
 {# call gtk_expander_set_label_widget #} expander (toWidget widget)

expanderGetLabelWidget :: Expander -> IO Widget
expanderGetLabelWidget expander = 
 makeNewObject mkWidget $
 {# call gtk_expander_get_label_widget #} expander

onActivate :: Expander -> IO () -> IO (ConnectId Expander)
afterActivate :: Expander -> IO () -> IO (ConnectId Expander)
onActivate = connect_NONE__NONE "activate" False
afterActivate = connect_NONE__NONE "activate" True

#endif

--- Expander.chspp DELETED ---

--- Alignment.chspp DELETED ---

--- NEW FILE: Alignment.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Alignment
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:40 $
--
--  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.
--
-- |
--
module Alignment(
  Alignment,
  AlignmentClass,
  castToAlignment,
  alignmentNew,
  alignmentSet
#if GTK_CHECK_VERSION(2,4,0)
 ,alignmentSetPadding,
  alignmentGetPadding
#endif
  ) where

import Monad	(liftM)
import FFI

import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}

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

-- methods

-- | Create an alignment widget. This widget tells
-- its child widget how to use the given space.
--
alignmentNew :: Float -> Float -> Float -> Float -> IO Alignment
alignmentNew yscale xalign yalign xscale = makeNewObject mkAlignment $
  liftM castPtr $ {#call unsafe alignment_new#} (realToFrac xalign) 
  (realToFrac yalign) (realToFrac xscale) (realToFrac yscale)


-- | Change the space use behaviour of an 'Alignment'.
--
alignmentSet :: AlignmentClass al => al -> Float -> Float -> Float -> Float ->
                IO ()
alignmentSet al xalign yalign xscale yscale = {#call alignment_set#}
  (toAlignment al) (realToFrac xalign) (realToFrac yalign)
  (realToFrac xscale) (realToFrac yscale)

#if GTK_CHECK_VERSION(2,4,0)
-- | Sets the padding on the different sides of the widget.
--
alignmentSetPadding :: AlignmentClass al => al -> Int -> Int -> Int -> Int ->
                       IO ()
alignmentSetPadding al top bottom left right =
  {# call gtk_alignment_set_padding #} (toAlignment al)
    (fromIntegral top) (fromIntegral bottom)
    (fromIntegral left) (fromIntegral right)

-- | Gets the padding on the different sides of the widget.
--
alignmentGetPadding :: AlignmentClass al => al -> IO (Int, Int, Int, Int)
alignmentGetPadding al =
  alloca $ \topPtr -> alloca $ \bottomPtr ->
  alloca $ \leftPtr -> alloca $ \rightPtr -> do
  {# call gtk_alignment_get_padding #} (toAlignment al)
    topPtr bottomPtr leftPtr rightPtr
  top    <- peek topPtr
  bottom <- peek bottomPtr
  left   <- peek leftPtr
  right  <- peek rightPtr
  return (fromIntegral top, fromIntegral bottom
         ,fromIntegral left, fromIntegral right)
  
#endif

[Gtk2hs-commit] gtk2hs/gtk/general Enums.chs.cpp,NONE,1.1 IconFactory.chs.cpp,NONE,1.1 Enums.chspp,1.1,NONE IconFactory.chspp,1.1,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/general
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24829/gtk/general

Added Files:
	Enums.chs.cpp IconFactory.chs.cpp 
Removed Files:
	Enums.chspp IconFactory.chspp 
Log Message:
Enhance makefile so that it builds the library. Changed .chspp to .chs.cpp in
all pre-processed chs files. Build with ghc --make the first time and with
ghc -c on incremental changes.


--- NEW FILE: Enums.chs.cpp ---
--  -*-haskell-*-
--  GIMP Toolkit (GTK) Enumerations
--
--  Author : Axel Simon, Manuel Chakravarty
--  Created: 13 Januar 1999
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:39 $
--
--  Copyright (c) [1999..2001] Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- General enumeration types.
--
-- TODO
--
--  * Documentation
--
module Enums(
  AccelFlags(..),
  ArrowType(..),
  AttachOptions(..),
  Button(..),
  ButtonBoxStyle(..),
  CalendarDisplayOptions(..),
  Click(..),
  CornerType(..),
  CurveType(..),
  DeleteType(..),
  DirectionType(..),
  Justification(..),
#ifndef DISABLE_DEPRECATED
  MatchType(..),
#endif
  MenuDirectionType(..),
  MetricType(..),
  MovementStep(..),
  Orientation(..),
  Packing(..),
  PackType(..),
  PathPriorityType(..),
  PathType(..),
  PolicyType(..),
  PositionType(..),
  ProgressBarOrientation(..),
  ReliefStyle(..),
  ResizeMode(..),
  ScrollType(..),
  SelectionMode(..),
  ShadowType(..),
  StateType(..),
#ifndef DISABLE_DEPRECATED
  SubmenuDirection(..),
  SubmenuPlacement(..),
#endif
  SpinButtonUpdatePolicy(..),
  SpinType(..),
  TextDirection(..),
  TextSearchFlags(..),
  TextWindowType(..),
  ToolbarStyle(..),
  TreeViewColumnSizing(..),
  --TroughType(..),
  UpdateType(..),
  Visibility(..),
  WindowPosition(..),
  WindowType(..),
  WrapMode(..), 
  SortType(..),
  module GdkEnums
  ) where

import GdkEnums

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


-- | state of an accelerator
--
{#enum AccelFlags {underscoreToCase} deriving(Bounded)#}

instance Flags AccelFlags

-- | arrow directions for the arrow widget
--
{#enum ArrowType {underscoreToCase}#}

-- | child widget attach options for table containers
--
{#enum AttachOptions {underscoreToCase} deriving(Bounded)#}

instance Flags AttachOptions

-- | button number
--
data Button = LeftButton
	    | MiddleButton
	    | RightButton
	    | WheelUp
	    | WheelDown
	    | OtherButton

instance Enum Button where
  toEnum 1 = LeftButton
  toEnum 2 = MiddleButton
  toEnum 3 = RightButton
  toEnum 4 = WheelUp
  toEnum 5 = WheelDown
  toEnum _ = OtherButton
  fromEnum LeftButton   = 1
  fromEnum MiddleButton = 2
  fromEnum RightButton  = 3
  fromEnum WheelUp	= 4
  fromEnum WheelDown	= 5
  fromEnum OtherButton	= 6

-- | dictate the style that a ButtonBox uses to align it
-- contents
--
{#enum ButtonBoxStyle {underscoreToCase}#}

-- | Specify which items of a calendar should be
-- displayed.
--
{#enum CalendarDisplayOptions {underscoreToCase} deriving(Bounded)#}

instance Flags CalendarDisplayOptions

-- | type of mouse click
--
data Click = SingleClick
	   | DoubleClick
	   | TripleClick
	   | ReleaseClick

-- | specifies in which corner a child widget should be placed
--
{#enum CornerType {underscoreToCase}#}

-- | specifies how curves in the gamma widget (?) are drawn
--
{#enum CurveType {underscoreToCase}#}

-- | editing option
--
{#enum DeleteType {underscoreToCase}#}

-- | editing direction
--
{#enum DirectionType {underscoreToCase}#}

-- | justification for label and maybe other widgets
-- (text?)
--
{#enum Justification {underscoreToCase}#}

#ifndef DISABLE_DEPRECATED
-- | some kind of string search options
--
{#enum MatchType {underscoreToCase}#}
#endif

-- | From where was a menu item entered?
--
{#enum MenuDirectionType {underscoreToCase}#}

-- | units of measure
--
{#enum MetricType {underscoreToCase}#}

-- | movement in text widget
--
{#enum MovementStep {underscoreToCase}#}

-- | orientation is good
--
{#enum Orientation {underscoreToCase}#}

-- | packing parameters of a widget
--
data Packing = PackRepel
	     | PackGrow
	     | PackNatural
	     deriving (Enum,Eq)

-- packing of widgets at start or end in a box
--
{#enum PackType {underscoreToCase}#}

-- | priorities
--
{#enum PathPriorityType {underscoreToCase}#}

-- | widget identification path
--
{#enum PathType {underscoreToCase}#}

-- | Scrollbar policy types (for scrolled windows)
--
{#enum PolicyType {underscoreToCase}#}

-- | position a scale's value is drawn relative to the
-- trough
--
{#enum PositionType {underscoreToCase}#}

-- | Is the ProgressBar horizontally or vertically
-- directed?
--
{#enum ProgressBarOrientation {underscoreToCase}#}

-- | I don't have a clue.
--
{#enum ReliefStyle {underscoreToCase}#}

-- | resize mode, for containers
--
-- * 'ResizeParent' Pass resize request to the parent
--
-- * 'ResizeQueue' Queue resizes on this widget
--
-- * 'ResizeImmediate' Perform the resizes now
--
{#enum ResizeMode {underscoreToCase}#}

-- | scrolling type
--
{#enum ScrollType {underscoreToCase}#}

-- | mode in which selections can be performed
--
-- * There is a deprecated entry SelectionExtended which should have the same
--   value as SelectionMultiple. C2HS chokes on that construct.
--
data SelectionMode = SelectionNone
                   | SelectionSingle
                   | SelectionBrowse
                   | SelectionMultiple
                   deriving (Enum)
-- {#enum SelectionMode {underscoreToCase}#}

-- | shadow types
--
{#enum ShadowType {underscoreToCase}#}

-- | widget states
--
{#enum StateType {underscoreToCase}#}

#ifndef DISABLE_DEPRECATED
-- | Submenu direction policies
--
{#enum SubmenuDirection {underscoreToCase}#}

-- | Submenu placement policies
--
{#enum SubmenuPlacement {underscoreToCase}#}
#endif

-- | Whether to clamp or ignore illegal values.
--
{#enum SpinButtonUpdatePolicy {underscoreToCase}#}

-- | Spin a SpinButton with the following method.
--
{#enum SpinType {underscoreToCase}#}

-- | Is the text written from left to right or the awkward
-- way?
--
{#enum TextDirection {underscoreToCase}#}

-- | Specify the way the search function for
-- 'TextBuffer' works.
--
{#enum TextSearchFlags {underscoreToCase} deriving(Bounded)#}

instance Flags TextSearchFlags

-- | The window type for coordinate translation.
--
{#enum TextWindowType {underscoreToCase}#}

-- | Where to place the toolbar?
--
{#enum ToolbarStyle {underscoreToCase}#}

-- | Wether columns of a tree or list widget can be
-- resized.
--
{#enum TreeViewColumnSizing {underscoreToCase}#}

-- hm... text editing?
--{#enum TroughType {underscoreToCase}#}


-- | updating types for range widgets (determines when the
-- @\"connectToValueChanged\"@ signal is emitted by the widget)
--
{#enum UpdateType {underscoreToCase}#}

-- | visibility
--
{#enum Visibility {underscoreToCase}#}

-- | window position types
--
{#enum WindowPosition {underscoreToCase}#}

-- | interaction of a window with window manager
--
{#enum WindowType {underscoreToCase}#}

-- | Determine how lines are wrapped in a 'TextView'.
--
{#enum WrapMode {underscoreToCase}#}

-- sort in ascending or descending order (used in CList widget)
--
{#enum SortType {underscoreToCase}#}


--- NEW FILE: IconFactory.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) IconFactory
--
--  Author : Axel Simon
--          
--  Created: 24 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:39 $
--
--  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.
--
-- |
--
-- This module provides access to IconFactory, IconSet and IconSource.
--
-- TODO
--
-- * The following functions are not bound:
--   iconFactoryLookup, iconFactoryLookupDefault
--   It is not a good idea to lookup an IconSet directly. If an Icon needs to
--   be displayed it happends always in the context of a widget. The best
--   practice is to get the widgets Style and call styleLookupIconSet.
--
module IconFactory(
  IconFactory,
  iconFactoryNew,
  iconFactoryAdd,
  iconFactoryAddDefault,
  iconFactoryLookup,
  iconFactoryLookupDefault,
  iconFactoryRemoveDefault,
  IconSet,
  iconSetNew,
  iconSetNewFromPixbuf,
  iconSetAddSource,
  iconSetRenderIcon,
  iconSetGetSizes,
  IconSource,
  iconSourceNew,
  TextDirection(..),
  iconSourceGetDirection,
  iconSourceSetDirection,
  iconSourceResetDirection,
  iconSourceGetFilename,
  iconSourceSetFilename,
  iconSourceGetPixbuf,
  iconSourceSetPixbuf,
  iconSourceGetSize,
  iconSourceSetSize,
  iconSourceResetSize,
  StateType(..),
  iconSourceGetState,
  iconSourceSetState,
  iconSourceResetState,
  IconSize,
  iconSizeMenu,
  iconSizeSmallToolbar,
  iconSizeLargeToolbar,
  iconSizeButton,
  iconSizeDialog,
  iconSizeCheck,
  iconSizeRegister,
  iconSizeRegisterAlias,
  iconSizeFromName,
  iconSizeGetName
  ) where

import Monad	(liftM)
import FFI
import GObject	(makeNewGObject)
{#import Hierarchy#}
{#import Signal#}
import Enums	(TextDirection(..), StateType(..))
import Structs	(IconSize, iconSizeInvalid, iconSizeMenu, iconSizeSmallToolbar,
		 iconSizeLargeToolbar, iconSizeButton, iconSizeDialog)

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

{#pointer *IconSource foreign newtype#}

{#pointer *IconSet foreign newtype#}

-- methods


-- | Add an IconSet to an IconFactory.
--
-- * In order to use the new stock object, the factory as to be added to the
--   default factories by iconFactoryAddDefault.
--
iconFactoryAdd :: IconFactory -> String -> IconSet -> IO ()
iconFactoryAdd i stockId iconSet = withUTFString stockId $ \strPtr ->
  {#call unsafe icon_factory_add#} i strPtr iconSet

-- | Add all entries of the IconFactory to the
-- applications stock object database.
--
iconFactoryAddDefault :: IconFactory -> IO ()
iconFactoryAddDefault  = {#call unsafe icon_factory_add_default#}

-- | Looks up the stock id in the icon factory, returning an icon set if found,
-- otherwise Nothing.
--
-- * For display to the user, you should use 'styleLookupIconSet' on the "Style"
-- for the widget that will display the icon, instead of using this function
-- directly, so that themes are taken into account.
--
iconFactoryLookup :: IconFactory -> String -> IO (Maybe IconSet)
iconFactoryLookup i stockId =
  withUTFString stockId $ \strPtr -> do
  iconSetPtr <- {#call unsafe icon_factory_lookup#} i strPtr
  if iconSetPtr == nullPtr then return Nothing else liftM (Just . IconSet) $
    newForeignPtr iconSetPtr (icon_set_unref iconSetPtr)

-- | Looks for an icon in the list of default icon factories.
--
-- * For display to the user, you should use 'styleLookupIconSet' on the "Style"
-- for the widget that will display the icon, instead of using this function
-- directly, so that themes are taken into account.
--
iconFactoryLookupDefault :: String -> IO (Maybe IconSet)
iconFactoryLookupDefault stockId =
  withUTFString stockId $ \strPtr -> do
  iconSetPtr <- {#call unsafe icon_factory_lookup_default#} strPtr
  if iconSetPtr == nullPtr then return Nothing else liftM (Just . IconSet) $
    newForeignPtr iconSetPtr (icon_set_unref iconSetPtr)

-- | Create a new IconFactory.
--
-- * An application should create a new 'IconFactory' and add all
--   needed icons.
--   By calling 'iconFactoryAddDefault' these icons become
--   available as stock objects and can easily be displayed by
--   'Image'. Furthermore, a theme can override the icons defined by
--   the application.
--
iconFactoryNew :: IO IconFactory
iconFactoryNew  = makeNewGObject mkIconFactory {#call unsafe icon_factory_new#}

-- | Remove an IconFactory from the
-- application's stock database.
--
iconFactoryRemoveDefault :: IconFactory -> IO ()
iconFactoryRemoveDefault  = {#call unsafe icon_factory_remove_default#}

-- | Add an 'IconSource' (an Icon with
-- attributes) to an 'IconSet'.
--
-- * If an icon is looked up in the IconSet @set@ the best matching
--   IconSource will be taken. It is therefore advisable to add a default
--   (wildcarded) icon, than can be used if no exact match is found.
--
iconSetAddSource :: IconSet -> IconSource -> IO ()
iconSetAddSource set source = {#call unsafe icon_set_add_source#} set source

iconSetRenderIcon :: WidgetClass widget => IconSet
                  -> TextDirection
                  -> StateType
                  -> IconSize
                  -> widget
                  -> IO Pixbuf
iconSetRenderIcon set dir state size widget = makeNewGObject mkPixbuf $
  {#call icon_set_render_icon#} set (Style nullForeignPtr)
    ((fromIntegral.fromEnum) dir) ((fromIntegral.fromEnum) state)
    ((fromIntegral.fromEnum) size) (toWidget widget) nullPtr

-- | Create a new IconSet.
--
-- * Each icon in an application is contained in an 'IconSet'. The
--   'IconSet' contains several variants ('IconSource's) to
--   accomodate for different sizes and states.
--
iconSetNew :: IO IconSet
iconSetNew  = do
  isPtr <- {#call unsafe icon_set_new#}
  liftM IconSet $ newForeignPtr isPtr (icon_set_unref isPtr)

-- | Creates a new 'IconSet' with the given pixbuf as the default\/fallback
-- source image. If you don't add any additional "IconSource" to the icon set,
-- all variants of the icon will be created from the pixbuf, using scaling,
-- pixelation, etc. as required to adjust the icon size or make the icon look
-- insensitive\/prelighted.
--
iconSetNewFromPixbuf :: Pixbuf -> IO IconSet
iconSetNewFromPixbuf pixbuf = do
  isPtr <- {#call unsafe icon_set_new_from_pixbuf#} pixbuf
  liftM IconSet $ newForeignPtr isPtr (icon_set_unref isPtr)

-- | Obtains a list of icon sizes this icon set can render.
--
iconSetGetSizes :: IconSet -> IO [IconSize]
iconSetGetSizes set =
  alloca $ \sizesArrPtr -> alloca $ \lenPtr -> do
  {#call unsafe icon_set_get_sizes#} set sizesArrPtr lenPtr
  len <- peek lenPtr
  sizesArr <- peek sizesArrPtr
  list <- peekArray (fromIntegral len) sizesArr
  {#call unsafe g_free#} (castPtr sizesArr)
  return $ map (toEnum.fromIntegral) list

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&gtk_icon_set_unref"
  icon_set_unref' :: FinalizerPtr IconSet

icon_set_unref :: Ptr IconSet -> FinalizerPtr IconSet
icon_set_unref _ = icon_set_unref'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gtk_icon_set_unref"
  icon_set_unref :: Ptr IconSet -> IO ()

#else

foreign import ccall "gtk_icon_set_unref" unsafe
  icon_set_unref :: Ptr IconSet -> IO ()

#endif


-- | Check if a given IconSize is registered.
--
-- * Useful if your application expects a theme to install a set with a
--   specific size. You can test if this actually happend and use another size
--   if not.
--
iconSizeCheck :: IconSize -> IO Bool
iconSizeCheck size = liftM toBool $
  {#call icon_size_lookup#} (fromIntegral size) nullPtr nullPtr

-- | Register a new IconSize.
--
iconSizeRegister :: Int -> String -> Int -> IO IconSize
iconSizeRegister height name width = liftM fromIntegral $
  withUTFString name $ \strPtr -> {#call unsafe icon_size_register#} 
  strPtr (fromIntegral width) (fromIntegral height)

-- | Register an additional alias for a name.
--
iconSizeRegisterAlias :: IconSize -> String -> IO ()
iconSizeRegisterAlias target alias = withUTFString alias $ \strPtr ->
  {#call unsafe icon_size_register_alias#} strPtr (fromIntegral target)

-- | Lookup an IconSize by name.
--
-- * This fixed value 'iconSizeInvalid' is returned if the name was
--   not found.
--
iconSizeFromName :: String -> IO IconSize
iconSizeFromName name = liftM fromIntegral $
  withUTFString name {#call unsafe icon_size_from_name#}

-- | Lookup the name of an IconSize.
--
-- * Returns @Nothing@ if the name was not found.
--
iconSizeGetName :: IconSize -> IO (Maybe String)
iconSizeGetName size = do
  strPtr <- {#call unsafe icon_size_get_name#} (fromIntegral size)
  if strPtr==nullPtr then return Nothing else liftM Just $ peekUTFString strPtr

-- | Retrieve the 'TextDirection' of
-- this IconSource.
--
-- * @Nothing@ is returned if no explicit direction was set.
--
iconSourceGetDirection :: IconSource -> IO (Maybe TextDirection)
iconSourceGetDirection is = do
  res <- {#call icon_source_get_direction_wildcarded#} is
  if (toBool res) then return Nothing else liftM (Just .toEnum.fromIntegral) $
    {#call unsafe icon_source_get_direction#} is

-- | Retrieve the filename this IconSource was
-- based on.
--
-- * Returns @Nothing@ if the IconSource was generated by a Pixbuf.
--
iconSourceGetFilename :: IconSource -> IO (Maybe String)
iconSourceGetFilename is = do
  strPtr <- {#call unsafe icon_source_get_filename#} is
  if strPtr==nullPtr then return Nothing else liftM Just $ peekUTFString strPtr

-- | Retrieve the 'IconSize' of this
-- IconSource.
--
-- * @Nothing@ is returned if no explicit size was set (i.e. this
--   'IconSource' matches all sizes).
--
iconSourceGetSize :: IconSource -> IO (Maybe IconSize)
iconSourceGetSize is = do
  res <- {#call unsafe icon_source_get_size_wildcarded#} is
  if (toBool res) then return Nothing else liftM (Just .fromIntegral) $
    {#call unsafe icon_source_get_size#} is

-- | Retrieve the 'StateType' of this
-- 'IconSource'.
--
-- * @Nothing@ is returned if the 'IconSource' matches all 
--   states.
--
iconSourceGetState :: IconSource -> IO (Maybe StateType)
iconSourceGetState is = do
  res <- {#call unsafe icon_source_get_state_wildcarded#} is
  if (toBool res) then return Nothing else liftM (Just .toEnum.fromIntegral) $
    {#call unsafe icon_source_get_state#} is

-- | Create a new IconSource.
--
-- * An IconSource is a single image that is usually added to an IconSet. Next
--   to the image it contains information about which state, text direction
--   and size it should apply.
--
iconSourceNew :: IO IconSource
iconSourceNew  = do
  isPtr <- {#call unsafe icon_source_new#}
  liftM IconSource $ newForeignPtr isPtr (icon_source_free isPtr)

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&gtk_icon_source_free"
  icon_source_free' :: FinalizerPtr IconSource

icon_source_free :: Ptr IconSource -> FinalizerPtr IconSource
icon_source_free _ = icon_source_free'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gtk_icon_source_free"
  icon_source_free :: Ptr IconSource -> IO ()

#else

foreign import ccall "gtk_icon_source_free" unsafe
  icon_source_free :: Ptr IconSource -> IO ()

#endif


-- | Mark this 'IconSource' that it
-- should only apply to the specified 'TextDirection'.
--
iconSourceSetDirection :: IconSource -> TextDirection -> IO ()
iconSourceSetDirection is td = do
  {#call unsafe icon_source_set_direction_wildcarded#} is (fromBool False)
  {#call unsafe icon_source_set_direction#} is ((fromIntegral.fromEnum) td)

-- | Reset the specific
-- 'TextDirection' set with 'iconSourceSetDirection'.
--
iconSourceResetDirection is =
  {#call unsafe icon_source_set_direction_wildcarded#} is (fromBool True)

-- | Load an icon picture from this filename.
--
iconSourceSetFilename :: IconSource -> FilePath -> IO ()
iconSourceSetFilename is name = 
  withUTFString name $ {#call unsafe icon_source_set_filename#} is

-- | Retrieves the source pixbuf, or Nothing if none is set.
--
iconSourceGetPixbuf :: IconSource -> IO (Maybe Pixbuf)
iconSourceGetPixbuf is = do
  pixbufPtr <- {#call unsafe icon_source_get_pixbuf#} is
  if pixbufPtr==nullPtr then return Nothing else liftM Just $
    makeNewGObject mkPixbuf (return pixbufPtr)

-- | Sets a pixbuf to use as a base image when creating icon variants for
-- 'IconSet'.
--
iconSourceSetPixbuf :: IconSource -> Pixbuf -> IO ()
iconSourceSetPixbuf is pb = do
  {#call icon_source_set_pixbuf#} is pb

-- | Set this 'IconSource' to a specific
-- size.
--
iconSourceSetSize :: IconSource -> IconSize -> IO ()
iconSourceSetSize is size = do
  {#call unsafe icon_source_set_size_wildcarded#} is (fromBool False)
  {#call unsafe icon_source_set_size#} is (fromIntegral size)

-- | Reset the 'IconSize' of this
-- 'IconSource' so that is matches anything.
--
iconSourceResetSize :: IconSource -> IO ()
iconSourceResetSize is = 
  {#call unsafe icon_source_set_size_wildcarded#} is (fromBool True)

-- | Mark this icon to be used only with this
-- specific state.
--
iconSourceSetState :: IconSource -> StateType -> IO ()
iconSourceSetState is state = do
  {#call unsafe icon_source_set_state_wildcarded#} is (fromBool False)
  {#call unsafe icon_source_set_state#} is ((fromIntegral.fromEnum) state)

-- | Reset the 'StateType' of this
-- 'IconSource' so that is matches anything.
--
iconSourceResetState :: IconSource -> IO ()
iconSourceResetState is = 
  {#call unsafe icon_source_set_state_wildcarded#} is (fromBool True)





--- IconFactory.chspp DELETED ---

--- Enums.chspp DELETED ---

[Gtk2hs-commit] gtk2hs/gtk/glib GError.chs.cpp,NONE,1.1 GObject.chs.cpp,NONE,1.1 GError.chspp,1.1,NONE GObject.chspp,1.1,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/glib
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24829/gtk/glib

Added Files:
	GError.chs.cpp GObject.chs.cpp 
Removed Files:
	GError.chspp GObject.chspp 
Log Message:
Enhance makefile so that it builds the library. Changed .chspp to .chs.cpp in
all pre-processed chs files. Build with ghc --make the first time and with
ghc -c on incremental changes.


--- GObject.chspp DELETED ---

--- NEW FILE: GObject.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget GObject
--
--  Author : Axel Simon
--          
--  Created: 9 April 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:40 $
--
--  Copyright (c) 2001 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.
--
-- |
--
-- Implements the base GObject class to satisfy the type checker.
--
module GObject(
  objectNew,
  objectRef,
  objectUnref,
  makeNewGObject,
  GWeakNotify,
  mkDestructor,
  objectWeakref,
  objectWeakunref
  ) where


import Monad (liftM)
import FFI
import LocalData (newIORef, readIORef, writeIORef)
import Hierarchy (GObjectClass, GObject(..),
                  mkGObject, toGObject, unGObject)
import GValue (GValue)
import GType  (GType)
import GParameter

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

{# pointer *GParameter as GParm -> GParameter #}

-- construct a new object (should rairly be used directly)
--
objectNew :: GType -> [(String, GValue)] -> IO (Ptr GObject)
objectNew objType parameters =
  liftM castPtr $ --caller must makeNewGObject as we don't know
                  --if it this a GObject or a GtkObject
  withArray (map GParameter parameters) $ \paramArrayPtr ->
  {# call g_object_newv #} objType
  (fromIntegral $ length parameters) paramArrayPtr

-- increase the reference counter of an object
--
objectRef :: GObjectClass obj => Ptr obj -> IO ()
objectRef obj = do
  {#call unsafe object_ref#} (castPtr obj)
  return ()

-- decrease the reference counter of an object
--
#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&g_object_unref"
  object_unref' :: FinalizerPtr a

objectUnref :: Ptr a -> FinalizerPtr a
objectUnref _ = object_unref'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "g_object_unref"
  objectUnref :: Ptr a -> IO ()

#else

foreign import ccall "g_object_unref" unsafe
  objectUnref :: Ptr a -> IO ()

#endif


-- This is a convenience function to generate an object that does not
-- derive from Object. It adds objectUnref as finalizer.
--
-- * The constr argument is the contructor of the specific object.
--
makeNewGObject :: GObjectClass obj => 
  (ForeignPtr obj -> obj) -> IO (Ptr obj) -> IO obj
makeNewGObject constr generator = do
  objPtr <- generator
  objectRef objPtr
  obj <- newForeignPtr objPtr (objectUnref objPtr)
  return $ constr obj

{#pointer GWeakNotify#}

foreign import ccall "wrapper" mkDestructor :: IO () -> IO GWeakNotify

-- | attach a callback that will be called after the
-- destroy hooks have been called
--
objectWeakref :: GObjectClass o => o -> IO () -> IO GWeakNotify
objectWeakref obj uFun = do
  funPtrContainer <- newIORef nullFunPtr
  uFunPtr <- mkDestructor $ do
    uFun
    funPtr <- readIORef funPtrContainer
    freeHaskellFunPtr funPtr
  writeIORef funPtrContainer uFunPtr
  withForeignPtr ((castForeignPtr.unGObject.toGObject) obj) $ \objPtr ->
    {#call unsafe object_weak_ref#} objPtr uFunPtr nullPtr
  return uFunPtr

-- | detach a weak destroy callback function
--
objectWeakunref :: GObjectClass o => o -> GWeakNotify -> IO ()
objectWeakunref obj fun = 
  withForeignPtr ((castForeignPtr.unGObject.toGObject) obj) $ \objPtr ->
    {#call unsafe object_weak_unref#} objPtr fun nullPtr
  


  

--- NEW FILE: GError.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) GError API
--
--  Author : Duncan Coutts
--  Created: 2 July 2004
--
--  Copyright (c) 2004 Duncan Coutts
--  parts derived from Structs.hsc Copyright (c) 1999..2002 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
--  Error Reporting, glib's system for reporting errors.
--
--  'GError's are used by glib to report recoverable runtime errors.
--
--  This module provides functions for checking glib\/gtk functions that report
--  'GError's. It also provides functions for throwing and catching 'GError's as
--  Haskell exceptions.
--

module GError (

  -- * Data types
  --
  GError(..),
  GErrorDomain,
  GErrorCode,
  GErrorMessage,
  
  -- * Catching GError exceptions
  -- | To catch GError exceptions thrown by gtk2hs functions use the catchGError*
  --   or handleGError* functions. They work in a similar way to the standard
  --   'Control.Exception.catch' and 'Control.Exception.handle' functions.
  --
  --   'catchGError'\/'handleGError' catches all GError exceptions, you provide a
  --   handler function that gets given the GError if an exception was thrown. This
  --   is the most general but is probably not what you want most of the time. It
  --   just gives you the raw error code rather than a Haskell enumeration of the
  --   error codes. Most of the time you will only want to catch a specific error
  --   or any error from a specific error domain. To catch just a single specific
  --   error use 'catchGErrorJust'\/'handleGErrorJust'. To catch any error in a 
  --   particular error domain use 'catchGErrorJustDomain'\/'handleGErrorJustDomain'
  --
  catchGError,
  catchGErrorJust,
  catchGErrorJustDomain,
  
  handleGError,
  handleGErrorJust,
  handleGErrorJustDomain,
  
  failOnGError,
  throwGError,

  -- * Checking for GErrors returned by glib\/gtk functions
  -- | * Note, these functions are only useful to implementors
  --
  --   If you are wrapping a new API that reports 'GError's you should probably use
  --   'propagateGError' to convert the GError into an exception. You should also
  --   note in the documentation for the function that it throws GError exceptions
  --   and the Haskell enumeration for the expected glib GError domain(s), so that
  --   users know what exceptions they might want to catch.
  --
  --   If you think it is more appropriate to use an alternate return value (eg
  --   Either\/Maybe) then you should use 'checkGError' or 'checkGErrorWithCont'.

  GErrorClass(..),
  propagateGError,
  checkGError,
  checkGErrorWithCont
  
  ) where

import FFI
import Monad (when)

import Control.Exception
import Data.Dynamic

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

-- | A GError consists of a domain, code and a human readable message.
data GError = GError !GErrorDomain !GErrorCode !GErrorMessage
# if __GLASGOW_HASKELL__>=600
  deriving Typeable
#else
{-# NOINLINE gerrorTypeRep #-}
gerrorTypeRep :: TypeRep
gerrorTypeRep = mkAppTy (mkTyCon "Graphics.UI.Gtk.GError.GError") []
instance Typeable GError where
  typeOf _ = gerrorTypeRep
#endif

type GQuark = {#type GQuark #}

-- | A code used to identify the \'namespace\' of the error. Within each error
--   domain all the error codes are defined in an enumeration. Each gtk\/gnome
--   module that uses GErrors has its own error domain. The rationale behind
--   using error domains is so that each module can organise its own error codes
--   without having to coordinate on a global error code list.
type GErrorDomain  = GQuark

-- | A code to identify a specific error within a given 'GErrorDomain'. Most of
--   time you will not need to deal with this raw code since there is an
--   enumeration type for each error domain. Of course which enumeraton to use
--   depends on the error domain, but if you use 'catchGErrorJustDomain' or
--   'handleGErrorJustDomain', this is worked out for you automatically.
type GErrorCode = Int

-- | A human readable error message.
type GErrorMessage = String
                                                                                           
instance Storable GError where
  sizeOf _ = {#sizeof GError #}
  alignment _ = alignment (undefined:: GQuark)
  peek ptr = do
    (domain  :: GQuark)         <- {#get GError->domain  #} ptr
    (code    :: {#type gint #}) <- {#get GError->code    #} ptr
    (msgPtr  :: CString)        <- {#get GError->message #} ptr
    msg <- peekUTFString msgPtr
    return $ GError (fromIntegral domain) (fromIntegral code) msg
  poke _ = error "GError::poke: not implemented"

-- | Each error domain's error enumeration type should be an instance of this
--   class. This class helps to hide the raw error and domain codes from the
--   user. This interface should be implemented by calling the approrpiate
--   @{error_domain}_error_quark@. It is safe to use 'unsafePerformIO' for this.
--
-- Example for 'PixbufError':
--
-- > instance GErrorClass PixbufError where
-- >   gerrorDomain _ = unsafePerformIO {#call unsafe pixbuf_error_quark#}
--
class Enum err => GErrorClass err where
  gerrorDomain :: err -> GErrorDomain -- ^ This must not use the value of its parameter
                                      --   so that it is safe to pass 'undefined'.

-- | Glib functions which report 'GError's take as a parameter a @GError **error@.
--   Use this function to supply such a parameter. It checks if an error was
--   reported and if so throws it as a Haskell exception.
--   
-- Example of use:
--
-- > propagateGError $ \gerrorPtr ->
-- > {# call g_some_function_that_might_return_an_error #} a b gerrorPtr
--
propagateGError :: (Ptr (Ptr ()) -> IO a) -> IO a
propagateGError action = checkGError action throwGError

-- | Like 'propagateGError' but instead of throwing the GError as an exception
--   handles the error immediately using the supplied error handler.
--
-- Example of use:
--
-- > checkGError
-- >   (\gerrorPtr -> {# call g_some_function_that_might_return_an_error #} a b gerrorPtr)
-- >   (\(GError domain code msg) -> ...)
--
checkGError :: (Ptr (Ptr ()) -> IO a) -> (GError -> IO a) -> IO a
checkGError action handler =
  alloca $ \(errPtrPtr  :: Ptr (Ptr GError)) -> do
  poke errPtrPtr nullPtr
  result <- action (castPtr errPtrPtr)
  errPtr <- peek errPtrPtr
  if errPtr == nullPtr
    then return result
    else do gerror <- peek errPtr
            {# call unsafe g_error_free #} (castPtr errPtr)
            handler gerror

-- | Like 'checkGError' but with an extra continuation applied to the result.
--   This can be useful when something needs to be done after making the call
--   to the function that can raise an error but is should only be done if there
--   was no error.
--
-- Example of use:
--
-- > checkGErrorWithCont (\gerrorPtr ->
-- >   {# call g_some_function_that_might_return_an_error #} a b gerrorPtr)
-- > (\(GError domain code msg) -> ...) -- what to do in case of error
-- > (\result -> ...)                   -- what to do after if no error
--
checkGErrorWithCont :: (Ptr (Ptr ()) -> IO b) -> (GError -> IO a) -> (b -> IO a) -> IO a
checkGErrorWithCont action handler cont =
  alloca $ \(errPtrPtr  :: Ptr (Ptr GError)) -> do
  poke errPtrPtr nullPtr
  result <- action (castPtr errPtrPtr)
  errPtr <- peek errPtrPtr
  if errPtr == nullPtr
    then cont result
    else do gerror <- peek errPtr
            {# call unsafe g_error_free #} (castPtr errPtr)
            handler gerror

-- | Use this if you need to explicitly throw a GError or re-throw an existing
--   GError that you do not wish to handle.
throwGError :: GError -> IO a
throwGError gerror = evaluate (throwDyn gerror)

-- | This will catch any GError exception. The handler function will receive the
--   raw GError. This is probably only useful when you want to take some action
--   that does not depend on which GError exception has occured, otherwise it
--   would be better to use either 'catchGErrorJust' or 'catchGErrorJustDomain'.
--   For example:
--
-- > catchGError
-- >   (do ...
-- >       ...)
-- >   (\(GError dom code msg) -> fail msg)
--   
catchGError :: IO a            -- ^ The computation to run
            -> (GError -> IO a) -- ^ Handler to invoke if an exception is raised
            -> IO a
catchGError action handler = catchDyn action handler

-- | This will catch just a specific GError exception. If you need to catch a
--   range of related errors, 'catchGErrorJustDomain' is probably more
--   appropriate. Example:
--
-- > do image <- catchGErrorJust PixbufErrorCorruptImage
-- >               loadImage
-- >               (\errorMessage -> do log errorMessage
-- >                                    return mssingImagePlaceholder)
--
catchGErrorJust :: GErrorClass err => err  -- ^ The error to catch
                -> IO a                    -- ^ The computation to run
                -> (GErrorMessage -> IO a) -- ^ Handler to invoke if an exception is raised
                -> IO a
catchGErrorJust code action handler = catchGError action handler'
  where handler' gerror@(GError domain code' msg)
          | fromIntegral domain == gerrorDomain code
           && code' == fromEnum code   = handler msg
          | otherwise                  = throwGError gerror

-- | Catch all GErrors from a particular error domain. The handler function
--   should just deal with one error enumeration type. If you need to catch
--   errors from more than one error domain, use this function twice with an
--   appropriate handler functions for each.
--
-- > catchGErrorJustDomain
-- >   loadImage
-- >   (\err message -> case err of
-- >       PixbufErrorCorruptImage -> ...
-- >       PixbufErrorInsufficientMemory -> ...
-- >       PixbufErrorUnknownType -> ...
-- >       _ -> ...)
--
catchGErrorJustDomain :: GErrorClass err => IO a        -- ^ The computation to run
                      -> (err -> GErrorMessage -> IO a) -- ^ Handler to invoke if an exception is raised
                      -> IO a
catchGErrorJustDomain action (handler :: err -> GErrorMessage -> IO a) =
    catchGError action handler'
  where handler' gerror@(GError domain code msg)
          | fromIntegral domain == gerrorDomain (undefined::err) = handler (toEnum code) msg
          | otherwise                                            = throwGError gerror

-- | A verson of 'catchGError' with the arguments swapped around.
--
-- > handleGError (\(GError dom code msg) -> ...) $
-- >   ...
--   
handleGError :: (GError -> IO a) -> IO a -> IO a
handleGError = flip catchGError

-- | A verson of 'handleGErrorJust' with the arguments swapped around.
handleGErrorJust :: GErrorClass err => err -> (GErrorMessage -> IO a) -> IO a -> IO a
handleGErrorJust code = flip (catchGErrorJust code)

-- | A verson of 'handleGErrorJustDomain' with the arguments swapped around.
handleGErrorJustDomain :: GErrorClass err => (err -> GErrorMessage -> IO a) -> IO a -> IO a
handleGErrorJustDomain = flip catchGErrorJustDomain

-- | Catch all GError exceptions and convert them into a general failure.
failOnGError :: IO a -> IO a
failOnGError action = catchGError action (\(GError dom code msg) -> fail msg)

--- GError.chspp DELETED ---

[Gtk2hs-commit] gtk2hs/gtk/entry Editable.chs.cpp,NONE,1.1 Entry.chs.cpp,NONE,1.1 EntryCompletion.chs.cpp,NONE,1.1 Editable.chspp,1.1,NONE Entry.chspp,1.1,NONE EntryCompletion.chspp,1.1,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/entry
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24829/gtk/entry

Added Files:
	Editable.chs.cpp Entry.chs.cpp EntryCompletion.chs.cpp 
Removed Files:
	Editable.chspp Entry.chspp EntryCompletion.chspp 
Log Message:
Enhance makefile so that it builds the library. Changed .chspp to .chs.cpp in
all pre-processed chs files. Build with ghc --make the first time and with
ghc -c on incremental changes.


--- NEW FILE: EntryCompletion.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) entry Widget EntryCompletion
--
--  Author : Duncan Coutts
--  Created: 24 April 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- Completion functionality for the Entry widget.
--
-- * Added in GTK+ 2.4
--
module EntryCompletion (
#if GTK_CHECK_VERSION(2,4,0)
  EntryCompletion,
  EntryCompletionClass,
  entryCompletionNew,
  entryCompletionGetEntry,
  entryCompletionSetModel,
  entryCompletionGetModel,
  entryCompletionSetMatchFunc,
  entryCompletionSetMinimumKeyLength,
  entryCompletionGetMinimumKeyLength,
  entryCompletionComplete,
  entryCompletionInsertActionText,
  entryCompletionInsertActionMarkup,
  entryCompletionDeleteAction,
  entryCompletionSetTextColumn
#endif
) where

#if GTK_CHECK_VERSION(2,4,0)

import Monad	(liftM)
import FFI
import LocalData (newIORef, readIORef, writeIORef)

import GObject (makeNewGObject)
import Object  (makeNewObject)
{#import Hierarchy#}
{#import Signal#}
{#import TreeModel#} (TreeIter, createTreeIter)

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

entryCompletionNew :: IO EntryCompletion
entryCompletionNew =
  makeNewGObject mkEntryCompletion $ liftM castPtr $
  {# call gtk_entry_completion_new #}

entryCompletionGetEntry :: EntryCompletion -> IO (Maybe Entry)
entryCompletionGetEntry ec = do
  entryPtr <- {# call gtk_entry_completion_get_entry #} ec
  if entryPtr == nullPtr
    then return Nothing
    else liftM Just $ makeNewObject mkEntry $ return (castPtr entryPtr)

entryCompletionSetModel :: EntryCompletion ->  TreeModel -> IO ()
entryCompletionSetModel ec tm =
  {# call gtk_entry_completion_set_model #} ec tm

entryCompletionGetModel :: EntryCompletion -> IO TreeModel
entryCompletionGetModel ec =
  makeNewGObject mkTreeModel $
  {# call gtk_entry_completion_get_model #} ec

entryCompletionSetMatchFunc :: EntryCompletion -> (String -> TreeIter -> IO ()) -> IO ()
entryCompletionSetMatchFunc ec handler =
  connect_GtkEntryCompletionMatchFunc ec handler

entryCompletionSetMinimumKeyLength :: EntryCompletion -> Int -> IO ()
entryCompletionSetMinimumKeyLength ec minLength =
  {# call gtk_entry_completion_set_minimum_key_length #} ec
    (fromIntegral minLength)

entryCompletionGetMinimumKeyLength :: EntryCompletion -> IO Int
entryCompletionGetMinimumKeyLength ec =
  liftM fromIntegral $
  {# call gtk_entry_completion_get_minimum_key_length #} ec

entryCompletionComplete :: EntryCompletion -> IO ()
entryCompletionComplete ec =
  {# call gtk_entry_completion_complete #} ec

entryCompletionInsertActionText :: EntryCompletion -> Int -> String -> IO ()
entryCompletionInsertActionText ec index text =
  withUTFString text $ \strPtr ->
  {# call gtk_entry_completion_insert_action_text #} ec
    (fromIntegral index) strPtr

entryCompletionInsertActionMarkup :: EntryCompletion -> Int -> String -> IO ()
entryCompletionInsertActionMarkup ec index markup =
  withUTFString markup $ \strPtr ->
  {# call gtk_entry_completion_insert_action_markup #} ec
    (fromIntegral index) strPtr 

entryCompletionDeleteAction :: EntryCompletion -> Int -> IO ()
entryCompletionDeleteAction ec index =
  {# call gtk_entry_completion_delete_action #} ec (fromIntegral index)

entryCompletionSetTextColumn :: EntryCompletion -> Int -> IO ()
entryCompletionSetTextColumn ec column =
  {# call gtk_entry_completion_set_text_column #} ec (fromIntegral column)


-------------------------------------------------
-- Callback stuff for entryCompletionSetMatchFunc
--
{#pointer GDestroyNotify#}

foreign import ccall "wrapper" mkDestructor :: IO () -> IO GDestroyNotify

type GtkEntryCompletionMatchFunc =
  Ptr EntryCompletion -> --GtkEntryCompletion *completion
  Ptr CChar ->           --const gchar *key
  Ptr TreeIter ->        --GtkTreeIter *iter
  Ptr () ->              --gpointer user_data
  IO ()

foreign import ccall "wrapper" mkHandler_GtkEntryCompletionMatchFunc ::
  GtkEntryCompletionMatchFunc -> 
  IO (FunPtr GtkEntryCompletionMatchFunc)

connect_GtkEntryCompletionMatchFunc :: EntryCompletion ->
                                       (String -> TreeIter -> IO ()) ->
                                       IO ()
connect_GtkEntryCompletionMatchFunc ec user = do
  hPtr <- mkHandler_GtkEntryCompletionMatchFunc
    (\_ keyPtr iterPtr _ -> do key <- peekUTFString keyPtr
                               iter <- createTreeIter iterPtr
                               user key iter)
  dRef <- newIORef nullFunPtr
  dPtr <- mkDestructor $ do
    freeHaskellFunPtr hPtr
    dPtr <- readIORef dRef
    freeHaskellFunPtr dPtr
  writeIORef dRef dPtr
  {# call gtk_entry_completion_set_match_func #} ec
    (castFunPtr hPtr) nullPtr dPtr
#endif

--- Entry.chspp DELETED ---

--- Editable.chspp DELETED ---

--- EntryCompletion.chspp DELETED ---

--- NEW FILE: Entry.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Entry
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:39 $
--
--  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.
--
-- |
--
-- * This widget lets the user enter a single line of text.
--
-- * TODO
--
-- * A couple of signals are not bound because I could not figure out what
--   they mean. Some of them do not seem to be emitted at all.
--
module Entry(
  Entry,
  EntryClass,
  castToEntry,
  entryNew,
  entrySetText,
  entryGetText,
#ifndef DISABLE_DEPRECATED
  entryAppendText,
  entryPrependText,
#endif
  entrySetVisibility,
  entryGetVisibility,
  entrySetInvisibleChar,
  entryGetInvisibleChar,
  entrySetMaxLength,
  entryGetActivatesDefault,
  entrySetActivatesDefault,
  entryGetHasFrame,
  entrySetHasFrame,
  entryGetWidthChars,
  entrySetWidthChars,
#if GTK_CHECK_VERSION(2,4,0)
  entrySetAlignment,
  entryGetAlignment,
  entrySetCompletion,
  entryGetCompletion,
#endif
  onEntryActivate,
  afterEntryActivate,
  onCopyClipboard,
  afterCopyClipboard,
  onCutClipboard,
  afterCutClipboard,
  onPasteClipboard,
  afterPasteClipboard,
  onInsertAtCursor,
  afterInsertAtCursor,
  onToggleOverwrite,
  afterToggleOverwrite
  ) where

import Monad	(liftM)
import FFI

import Object	(makeNewObject)
import GObject (makeNewGObject)
{#import Hierarchy#}
{#import Signal#}
import Char	(ord, chr)

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

-- GtkEntry implements the GtkEditable interface
instance EditableClass Entry

-- methods

-- | Create a new 'Entry' widget.
--
entryNew :: IO Entry
entryNew  = makeNewObject mkEntry $ liftM castPtr $ {#call unsafe entry_new#}

-- | Set the text of the 'Entry' widget.
--
entrySetText :: EntryClass ec => ec -> String -> IO ()
entrySetText ec str = withUTFString str $ {#call entry_set_text#} (toEntry ec)

-- | Get the text of the 'Entry' widget.
--
entryGetText :: EntryClass ec => ec -> IO String
entryGetText ec = {#call entry_get_text#} (toEntry ec) >>= peekUTFString

#ifndef DISABLE_DEPRECATED
-- | Append to the text of the 'Entry' widget.
--
entryAppendText :: EntryClass ec => ec -> String -> IO ()
entryAppendText ec str = 
  withUTFString str $ {#call entry_append_text#} (toEntry ec)

-- | Prepend the text of the 'Entry' widget.
--
entryPrependText :: EntryClass ec => ec -> String -> IO ()
entryPrependText ec str = 
  withUTFString str $ {#call entry_prepend_text#} (toEntry ec)
#endif

-- | Set whether to use password mode (display stars instead of the text).
--
-- * The replacement character can be changed with 'entrySetInvisibleChar'.
--
entrySetVisibility :: EntryClass ec => ec -> Bool -> IO ()
entrySetVisibility ec visible =
  {#call entry_set_visibility#} (toEntry ec) (fromBool visible)

-- | Get whether widget is in password mode.
--
entryGetVisibility :: EntryClass ec => ec -> IO Bool
entryGetVisibility ec =
  liftM toBool $ {#call entry_get_visibility#} (toEntry ec)

-- | Set the replacement character for invisible text.
--
entrySetInvisibleChar :: EntryClass ec => ec -> Char -> IO ()
entrySetInvisibleChar ec ch =
  {#call unsafe entry_set_invisible_char#} (toEntry ec) ((fromIntegral.ord) ch)

-- | Get the current replacement character for invisible text,
-- or 0 if not in password mode.
--
entryGetInvisibleChar :: EntryClass ec => ec -> IO Char
entryGetInvisibleChar ec = liftM (chr.fromIntegral) $
  {#call unsafe entry_get_invisible_char#} (toEntry ec)

-- | Sets a maximum length the text may grow to.
--
-- * A negative number resets the restriction.
--
entrySetMaxLength :: EntryClass ec => ec -> Int -> IO ()
entrySetMaxLength ec max = 
  {#call entry_set_max_length#} (toEntry ec) (fromIntegral max)

-- | Gets a maximum length the text is allowed to grow to.
--
entryGetMaxLength :: EntryClass ec => ec -> IO Int
entryGetMaxLength ec =
  liftM fromIntegral $ {#call unsafe entry_get_max_length#} (toEntry ec)

-- | Query whether pressing return will activate the default widget.
--
entryGetActivatesDefault :: EntryClass ec => ec -> IO Bool
entryGetActivatesDefault ec = liftM toBool $
  {#call unsafe entry_get_activates_default#} (toEntry ec)

-- | Specify if pressing return will activate
-- the default widget.
--
-- * This setting is useful in 'Dialog' boxes where enter should press
--   the default button.
--
entrySetActivatesDefault :: EntryClass ec => ec -> Bool -> IO ()
entrySetActivatesDefault ec setting = {#call entry_set_activates_default#}
  (toEntry ec) (fromBool setting)

-- | Query if the text 'Entry' is displayed with a frame around it.
--
entryGetHasFrame :: EntryClass ec => ec -> IO Bool
entryGetHasFrame ec = liftM toBool $
  {#call unsafe entry_get_has_frame#} (toEntry ec)

-- | Specifies whehter the 'Entry' should be in an etched-in frame.
--
entrySetHasFrame :: EntryClass ec => ec -> Bool -> IO ()
entrySetHasFrame ec setting = {#call entry_set_has_frame#}
  (toEntry ec) (fromBool setting)

-- | Retrieve the number of characters the widget should ask for.
--
entryGetWidthChars :: EntryClass ec => ec -> IO Int
entryGetWidthChars ec = liftM fromIntegral $ 
  {#call unsafe entry_get_width_chars#} (toEntry ec)

-- | Specifies how large the 'Entry' should be in characters.
--
-- * This setting is only considered when the widget formulates its size
--   request. Make sure that it is not mapped (shown) before you change this
--   value.
--
entrySetWidthChars :: EntryClass ec => ec -> Int -> IO ()
entrySetWidthChars ec setting = {#call entry_set_width_chars#}
  (toEntry ec) (fromIntegral setting)

#if GTK_CHECK_VERSION(2,4,0)
-- | Sets the alignment for the contents of the entry. This controls the
-- horizontal positioning of the contents when the displayed text is shorter
-- than the width of the entry.
--
-- * Since gtk 2.4
--
entrySetAlignment :: EntryClass ec => ec -> Float -> IO ()
entrySetAlignment ec xalign =
  {#call entry_set_alignment#} (toEntry ec) (realToFrac xalign)

-- | Gets the value set by 'entrySetAlignment'.
--
-- * Since gtk 2.4
--
entryGetAlignment :: EntryClass ec => ec -> IO Float
entryGetAlignment ec =
  liftM realToFrac $ {#call unsafe entry_get_alignment#} (toEntry ec)

-- | Sets the auxiliary completion object to use with the entry. All further
-- configuration of the completion mechanism is done on completion using the
-- "EntryCompletion" API.
--
-- * Since gtk 2.4
--
entrySetCompletion :: EntryClass ec => ec -> EntryCompletion -> IO ()
entrySetCompletion ec completion = {#call gtk_entry_set_completion#}
  (toEntry ec) completion

-- | Returns the auxiliary completion object currently in use by the entry.
--
-- * Since gtk 2.4
--
entryGetCompletion :: EntryClass ec => ec -> IO EntryCompletion
entryGetCompletion ec =
  makeNewGObject mkEntryCompletion $
  {#call gtk_entry_get_completion#} (toEntry ec)
#endif


-- signals

-- | Emitted when the user presses return within
-- the 'Entry' field.
--
onEntryActivate, afterEntryActivate :: EntryClass ec => ec -> IO () ->
                                       IO (ConnectId ec)
onEntryActivate = connect_NONE__NONE "activate" False
afterEntryActivate = connect_NONE__NONE "activate" True

-- | Emitted when the settings of the
-- 'Entry' widget changes.
--
onEntryChanged, afterEntryChanged :: EntryClass ec => ec -> IO () ->
                                     IO (ConnectId ec)
onEntryChanged = connect_NONE__NONE "changed" False
afterEntryChanged = connect_NONE__NONE "changed" True

-- | Emitted when the current selection has been
-- copied to the clipboard.
--
onCopyClipboard, afterCopyClipboard :: EntryClass ec => ec -> IO () ->
                                       IO (ConnectId ec)
onCopyClipboard = connect_NONE__NONE "copy_clipboard" False
afterCopyClipboard = connect_NONE__NONE "copy_clipboard" True

-- | Emitted when the current selection has been
-- cut to the clipboard.
--
onCutClipboard, afterCutClipboard :: EntryClass ec => ec -> IO () ->
                                     IO (ConnectId ec)
onCutClipboard = connect_NONE__NONE "cut_clipboard" False
afterCutClipboard = connect_NONE__NONE "cut_clipboard" True

-- | Emitted when the current selection has
-- been pasted from the clipboard.
--
onPasteClipboard, afterPasteClipboard :: EntryClass ec => ec -> IO () ->
                                         IO (ConnectId ec)
onPasteClipboard = connect_NONE__NONE "paste_clipboard" False
afterPasteClipboard = connect_NONE__NONE "paste_clipboard" True

-- | Emitted when a piece of text is deleted from
-- the 'Entry'.
--
onDeleteText, afterDeleteText :: EntryClass ec => ec ->
                                 (Int -> Int -> IO ()) -> IO (ConnectId ec)
onDeleteText = connect_INT_INT__NONE "delete_text" False
afterDeleteText = connect_INT_INT__NONE "delete_text" True

-- | Emitted when a piece of text is inserted
-- at the cursor position.
--
onInsertAtCursor, afterInsertAtCursor :: EntryClass ec => ec ->
                                         (String -> IO ()) ->
                                         IO (ConnectId ec)
onInsertAtCursor = connect_STRING__NONE "insert_at_cursor" False
afterInsertAtCursor = connect_STRING__NONE "insert_at_cursor" True

-- | Emitted when the user changes from
-- overwriting to inserting.
--
onToggleOverwrite, afterToggleOverwrite :: EntryClass ec => ec -> IO () ->
                                           IO (ConnectId ec)
onToggleOverwrite = connect_NONE__NONE "toggle_overwrite" False
afterToggleOverwrite = connect_NONE__NONE "toggle_overwrite" True

--- NEW FILE: Editable.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Interface Editable
--
--  Author : Axel Simon, Duncan Coutts
--          
--  Created: 30 July 2004
--  split off from Entry.chs
--
--  Copyright (c) 1999..2002 Axel Simon
--  modified 2004 Duncan Coutts
--
--  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.
--
-- |
--
-- * This is an interface for simple single-line text editing widgets. It is
--   implemented by "Entry" and "SpinButton".
--
-- * TODO
--
-- * Find out if \"insert-text\" signal is useful and how to bind it. It is
--   tricky because it has an in-out parameter.
--
module Editable(
  -- * Data types
  Editable,
  EditableClass,
  castToEditable,

  -- * Methods
  editableSelectRegion,
  editableGetSelectionBounds,
  editableInsertText,
  editableDeleteText,
  editableGetChars,
  editableCutClipboard,
  editableCopyClipboard,
  editablePasteClipboard,
  editableDeleteSelection,
  editableSetEditable,
  editableGetEditable,
  editableSetPosition,
  editableGetPosition,
  
  -- * Signals
  onEditableChanged,
  afterEditableChanged,
  onDeleteText,
  afterDeleteText,
  ) where

import Monad	(liftM)
import FFI

import Object	(makeNewObject)
import GObject (makeNewGObject)
{#import Hierarchy#}
{#import Signal#}

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

-- | Select a span of text.
--
-- * A negative @end@ position will make the selection extend to the
--   end of the buffer.
--
-- * Calling this function with @start@=1 and @end@=4 it will
--   mark \"ask\" in the string \"Haskell\". (FIXME: verify)
--
editableSelectRegion :: EditableClass ed => ed -> Int -> Int -> IO ()
editableSelectRegion ed start end =
  {#call editable_select_region#} (toEditable ed)
    (fromIntegral start) (fromIntegral end)

-- | Get the span of the current selection.
--
-- * The returned tuple is not ordered. The second index represents the
--   position of the cursor. The first index is the other end of the
--   selection. If both numbers are equal there is in fact no selection.
--
editableGetSelectionBounds :: EditableClass ed => ed -> IO (Int,Int)
editableGetSelectionBounds ed = alloca $ \startPtr -> alloca $ \endPtr -> do
  {#call unsafe editable_get_selection_bounds#} (toEditable ed) startPtr endPtr
  start <- liftM fromIntegral $ peek startPtr
  end	<- liftM fromIntegral $ peek endPtr
  return (start,end)

-- | Insert new text at the specified position.
--
-- * If the position is invalid the text will be inserted at the end of the
--   buffer. The returned value reflects the actual insertion point.
--
editableInsertText :: EditableClass ed => ed -> String -> Int -> IO Int
editableInsertText ed str pos = withObject (fromIntegral pos) $ \posPtr ->
  withUTFStringLen str $ \(strPtr,len) -> do
    {#call editable_insert_text#} (toEditable ed) strPtr (fromIntegral len) 
      posPtr
    liftM fromIntegral $ peek posPtr

-- | Delete a given range of text.
--
-- * If the @end@ position is invalid, it is set to the lenght of the
--   buffer.
--
-- * @start@ is restricted to 0..@end@.
--
editableDeleteText :: EditableClass ed => ed -> Int -> Int -> IO ()
editableDeleteText ed start end = {#call editable_delete_text#} (toEditable ed)
  (fromIntegral start) (fromIntegral end)

-- | Retrieve a range of characters.
--
-- * Set @end@ to a negative value to reach the end of the buffer.
--
editableGetChars :: EditableClass ed => ed -> Int -> Int -> IO String
editableGetChars ed start end = do
  strPtr <- {#call unsafe editable_get_chars#} (toEditable ed) 
    (fromIntegral start) (fromIntegral end)
  str <- peekUTFString strPtr
  {#call unsafe g_free#} (castPtr strPtr)
  return str

-- | Cut the selected characters to the Clipboard.
--
editableCutClipboard :: EditableClass ed => ed -> IO ()
editableCutClipboard  = {#call editable_cut_clipboard#}.toEditable

-- | Copy the selected characters to the Clipboard.
--
editableCopyClipboard :: EditableClass ed => ed -> IO ()
editableCopyClipboard  = {#call editable_copy_clipboard#}.toEditable

-- | Paste the selected characters to the
-- Clipboard.
--
editablePasteClipboard :: EditableClass ed => ed -> IO ()
editablePasteClipboard  = {#call editable_paste_clipboard#}.toEditable

-- | Delete the current selection.
--
editableDeleteSelection :: EditableClass ed => ed -> IO ()
editableDeleteSelection  = {#call editable_delete_selection#}.toEditable

-- | Set the cursor to a specific position.
--
editableSetPosition :: EditableClass ed => ed -> Int -> IO ()
editableSetPosition ed pos = 
  {#call editable_set_position#} (toEditable ed) (fromIntegral pos)

-- | Get the current cursor position.
--
editableGetPosition :: EditableClass ed => ed -> IO Int
editableGetPosition ed = liftM fromIntegral $
  {#call unsafe editable_get_position#} (toEditable ed)

-- | Make the widget insensitive.
--
-- * Called with False will make the text uneditable.
--
editableSetEditable :: EditableClass ed => ed -> Bool -> IO ()
editableSetEditable ed isEditable = {#call editable_set_editable#}
  (toEditable ed) (fromBool isEditable)

-- | Retrieves whether the text is editable.
--
editableGetEditable :: EditableClass ed => ed -> IO Bool
editableGetEditable ed =
  liftM toBool $ {#call editable_get_editable#} (toEditable ed)
  

-- signals

-- | Emitted when the settings of the 'Editable' widget changes.
--
onEditableChanged, afterEditableChanged :: EditableClass ec => ec -> IO () ->
                                     IO (ConnectId ec)
onEditableChanged = connect_NONE__NONE "changed" False
afterEditableChanged = connect_NONE__NONE "changed" True

-- | Emitted when a piece of text is deleted from the 'Editable' widget.
--
onDeleteText, afterDeleteText :: EditableClass ec => ec ->
                                 (Int -> Int -> IO ()) -> IO (ConnectId ec)
onDeleteText = connect_INT_INT__NONE "delete_text" False
afterDeleteText = connect_INT_INT__NONE "delete_text" True

[Gtk2hs-commit] gtk2hs/gtk/gdk Drawable.chs.cpp,NONE,1.1 Region.chs.cpp,NONE,1.1 Drawable.chspp,1.1,NONE Region.chspp,1.1,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/gdk
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24829/gtk/gdk

Added Files:
	Drawable.chs.cpp Region.chs.cpp 
Removed Files:
	Drawable.chspp Region.chspp 
Log Message:
Enhance makefile so that it builds the library. Changed .chspp to .chs.cpp in
all pre-processed chs files. Build with ghc --make the first time and with
ghc -c on incremental changes.


--- NEW FILE: Region.chs.cpp ---
--  -*-haskell-*-
--  GIMP Toolkit (GTK) Region
--
--  Author : Axel Simon
--  Created: 22 September 2002
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:39 $
--
--  Copyright (c) 2002 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- A set of rectangles describing areas to be redrawn.
--
-- * Regions consist of a set of non-overlapping rectangles. They are used to
--   specify the area of a window which needs updating.
--
-- TODO
--
-- * The Span functions and callbacks are not implemented since retrieving
--   a set of rectangles and working on them within Haskell seems to be easier.
--
module Region(
  makeNewRegion,
  Region(Region),
  regionNew,
  FillRule(..),
  regionPolygon,
  regionCopy,
  regionRectangle,
  regionGetClipbox,
  regionGetRectangles,
  regionEmpty,
  regionEqual,
  regionPointIn,
  OverlapType(..),
  regionRectIn,
  regionOffset,
  regionShrink,
  regionUnionWithRect,
  regionIntersect,
  regionUnion,
  regionSubtract,
  regionXor) where

import Monad	(liftM)
import FFI
import Structs	(Point, Rectangle(..))
import GdkEnums (FillRule(..), OverlapType(..))

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

{#pointer *GdkRegion as Region foreign newtype #}

-- Construct a region from a pointer.
--
makeNewRegion :: Ptr Region -> IO Region
makeNewRegion rPtr = do
  region <- newForeignPtr rPtr (region_destroy rPtr)
  return (Region region)

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&gdk_region_destroy"
  region_destroy' :: FinalizerPtr Region

region_destroy :: Ptr Region -> FinalizerPtr Region
region_destroy _ = region_destroy'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gdk_region_destroy"
  region_destroy :: Ptr Region -> IO ()

#else

foreign import ccall "gdk_region_destroy" unsafe
  region_destroy :: Ptr Region -> IO ()

#endif


-- | Create an empty region.
--
regionNew :: IO Region
regionNew = do
  rPtr <- {#call unsafe region_new#}
  makeNewRegion rPtr

-- | Convert a polygon into a 'Region'.
--
regionPolygon :: [Point] -> FillRule -> IO Region
regionPolygon points rule =
  withArray (concatMap (\(x,y) -> [fromIntegral x, fromIntegral y]) points) $
  \(aPtr :: Ptr {#type gint#}) -> do
    rPtr <- {#call unsafe region_polygon#} (castPtr aPtr) 
	    (fromIntegral (length points)) ((fromIntegral.fromEnum) rule)
    makeNewRegion rPtr

-- | Copy a 'Region'.
--
regionCopy :: Region -> IO Region
regionCopy r = do
  rPtr <- {#call unsafe region_copy#} r
  makeNewRegion rPtr

-- | Convert a rectangle to a 'Region'.
--
regionRectangle :: Rectangle -> IO Region
regionRectangle rect = withObject rect $ \rectPtr -> do
  regPtr <- {#call unsafe region_rectangle#} (castPtr rectPtr)
  makeNewRegion regPtr

-- | Smallest rectangle including the 
-- 'Region'.
--
regionGetClipbox :: Region -> IO Rectangle
regionGetClipbox r = alloca $ \rPtr -> do
  {#call unsafe region_get_clipbox#} r (castPtr rPtr)
  peek rPtr

-- | Turn the 'Region' into its rectangles.
--
-- * A 'Region' is a set of horizontal bands. Each band
--   consists of one or more rectangles of the same height. No rectangles
--   in a band touch.
--
regionGetRectangles :: Region -> IO [Rectangle]
regionGetRectangles r = 
  alloca $ \(aPtr :: Ptr Rectangle) -> 
  alloca $ \(iPtr :: Ptr {#type gint#}) -> do
    {#call unsafe region_get_rectangles#} r (castPtr aPtr) iPtr
    size <- peek iPtr
    regs <- peekArray (fromIntegral size) aPtr
    {#call unsafe g_free#} (castPtr aPtr)
    return regs

-- | Test if a 'Region' is empty.
--
regionEmpty :: Region -> IO Bool
regionEmpty r = liftM toBool $ {#call unsafe region_empty#} r

-- | Compares two 'Region's for equality.
--
regionEqual :: Region -> Region -> IO Bool
regionEqual r1 r2 = liftM toBool $ {#call unsafe region_equal#} r1 r2

-- | Checks if a point it is within a region.
--
regionPointIn :: Region -> Point -> IO Bool
regionPointIn r (x,y) = liftM toBool $ 
  {#call unsafe region_point_in#} r (fromIntegral x) (fromIntegral y)

-- | Check if a rectangle is within a region.
--
regionRectIn :: Region -> Rectangle -> IO OverlapType
regionRectIn reg rect = liftM (toEnum.fromIntegral) $ withObject rect $
  \rPtr -> {#call unsafe region_rect_in#} reg (castPtr rPtr)

-- | Move a region.
--
regionOffset :: Region -> Int -> Int -> IO ()
regionOffset r dx dy = 
  {#call unsafe region_offset#} r (fromIntegral dx) (fromIntegral dy)

-- | Move a region.
--
-- * Positive values shrink the region, negative values expand it.
--
regionShrink :: Region -> Int -> Int -> IO ()
regionShrink r dx dy = 
  {#call unsafe region_shrink#} r (fromIntegral dx) (fromIntegral dy)

-- | Updates the region to include the rectangle.
--
regionUnionWithRect :: Region -> Rectangle -> IO ()
regionUnionWithRect reg rect = withObject rect $ \rPtr ->
  {#call unsafe region_union_with_rect#} reg (castPtr rPtr)

-- | Intersects one region with another.
--
-- * Changes @reg1@ to include the common areas of @reg1@
--   and @reg2@.
--
regionIntersect :: Region -> Region -> IO ()
regionIntersect reg1 reg2 = {#call unsafe region_intersect#} reg1 reg2

-- | Unions one region with another.
--
-- * Changes @reg1@ to include @reg1@ and @reg2@.
--
regionUnion :: Region -> Region -> IO ()
regionUnion reg1 reg2 = {#call unsafe region_union#} reg1 reg2

-- | Removes pars of a 'Region'.
--
-- * Reduces the region @reg1@ so that is does not include any areas
--   of @reg2@.
--
regionSubtract :: Region -> Region -> IO ()
regionSubtract reg1 reg2 = {#call unsafe region_subtract#} reg1 reg2

-- | XORs two 'Region's.
--
-- * The exclusive or of two regions contains all areas which were not
--   overlapping. In other words, it is the union of the regions minus
--   their intersections.
--
regionXor :: Region -> Region -> IO ()
regionXor reg1 reg2 = {#call unsafe region_xor#} reg1 reg2



--- Region.chspp DELETED ---

--- Drawable.chspp DELETED ---

--- NEW FILE: Drawable.chs.cpp ---
{-# OPTIONS -cpp #-}
--  -*-haskell-*-
--  GIMP Toolkit (GTK) Drawable
--
--  Author : Axel Simon
--  Created: 22 September 2002
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:39 $
--
--  Copyright (c) 2002 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- Drawing primitives.
--
-- * This module defines drawing primitives that can operate on 
--   'DrawWindow's, 'Pixmap's and 
--   'Bitmap's.
--
-- TODO
--
-- * if gdk_visuals are implemented, do: get_visual
--
-- * if gdk_colormaps are implemented, do: set_colormap, get_colormap
--
-- * add draw_glyphs if we are desparate
--
module Drawable(
  Drawable,
  DrawableClass,
  castToDrawable,
  drawableGetDepth,
  drawableGetSize,
  drawableGetClipRegion,
  drawableGetVisibleRegion,
  Point,
  drawPoint,
  drawPoints,
  drawLine,
  drawLines,
#if GTK_CHECK_VERSION(2,2,0)
  Dither(..),
  drawPixbuf,
#endif
  drawSegments,
  drawRectangle,
  drawArc,
  drawPolygon,
  drawLayoutLine,
  drawLayoutLineWithColors,
  drawLayout,
  drawLayoutWithColors,
  drawDrawable) where

import Monad	(liftM)
import FFI

import GObject	(makeNewGObject)
import Structs  (Point)
{#import Hierarchy#}
{#import Region#}	(Region, makeNewRegion)
import Structs		(Color)
{#import PangoTypes#}
import GdkEnums         (Dither(..))

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

-- methods

-- | Get the size of pixels.
--
-- * Returns the number of bits which are use to store information on each
--   pixels in this 'Drawable'.
--
drawableGetDepth :: DrawableClass d => d -> IO Int
drawableGetDepth d = liftM fromIntegral $ 
		     {#call unsafe drawable_get_depth#} (toDrawable d)

-- | Retrieve the size of the 'Drawable'.
--
-- * The result might not be up-to-date if there are still resizing messages
--   to be processed.
--
drawableGetSize :: DrawableClass d => d -> IO (Int, Int)
drawableGetSize d = alloca $ \wPtr -> alloca $ \hPtr -> do
  {#call unsafe drawable_get_size#} (toDrawable d) wPtr hPtr
  (w::{#type gint#}) <- peek wPtr
  (h::{#type gint#}) <- peek hPtr
  return (fromIntegral w, fromIntegral h)

-- | Determine where not to draw.
--
-- * Computes the region of a drawable that potentially can be written
--   to by drawing primitives. This region will not take into account the
--   clip region for the GC, and may also not take into account other
--   factors such as if the window is obscured by other windows, but no
--   area outside of this region will be affected by drawing primitives.
--
drawableGetClipRegion :: DrawableClass d => d -> IO Region
drawableGetClipRegion d = do
  rPtr <- {#call unsafe drawable_get_clip_region#} (toDrawable d)
  makeNewRegion rPtr

-- | Determine what not to redraw.
--
-- * Computes the region of a drawable that is potentially visible.
-- This does not necessarily take into account if the window is obscured
-- by other windows, but no area outside of this region is visible.
--
drawableGetVisibleRegion :: DrawableClass d => d -> IO Region
drawableGetVisibleRegion d = do
  rPtr <- {#call unsafe drawable_get_visible_region#} (toDrawable d)
  makeNewRegion rPtr

-- | Draw a point into a 'Drawable'.
--
drawPoint :: DrawableClass d => d -> GC -> Point -> IO ()
drawPoint d gc (x,y) = {#call unsafe draw_point#} (toDrawable d)
  (toGC gc) (fromIntegral x) (fromIntegral y)


-- | Draw several points into a 'Drawable'.
--
-- * This function is more efficient than calling 'drawPoint' on
--   several points.
--
drawPoints :: DrawableClass d => d -> GC -> [Point] -> IO ()
drawPoints d gc []     = return ()
drawPoints d gc points = 
  withArray (concatMap (\(x,y) -> [fromIntegral x, fromIntegral y]) points) $
  \(aPtr :: Ptr {#type gint#}) -> {#call unsafe draw_points#} (toDrawable d)
    (toGC gc) (castPtr aPtr) (fromIntegral (length points))

-- | Draw a line into a 'Drawable'.
--
-- * The parameters are x1, y1, x2, y2.
--
-- * Drawing several separate lines can be done more efficiently by
--   'drawSegments'.
--
drawLine :: DrawableClass d => d -> GC -> Point -> Point -> IO ()
drawLine d gc (x1,y1) (x2,y2) = {#call unsafe draw_line#} (toDrawable d)
  (toGC gc) (fromIntegral x1) (fromIntegral y1) (fromIntegral x2) 
  (fromIntegral y2)

-- | Draw several lines.
--
-- * The function uses the current line width, dashing and especially the
--   joining specification in the graphics context (in contrast to
--   'drawSegments'.
--
drawLines :: DrawableClass d => d -> GC -> [Point] -> IO ()
drawLines d gc []     = return ()
drawLines d gc points =
  withArray (concatMap (\(x,y) -> [fromIntegral x, fromIntegral y]) points) $
  \(aPtr :: Ptr {#type gint#}) -> {#call unsafe draw_lines#} (toDrawable d)
    (toGC gc) (castPtr aPtr) (fromIntegral (length points))

#if GTK_CHECK_VERSION(2,2,0)
-- | Render a 'Pixbuf'.
--
-- * Renders a rectangular portion of a 'Pixbuf' to a
--   'Drawable'. The @srcX@, @srcY@,
--   @srcWidth@ and @srcHeight@ specify what part of the
--   'Pixbuf' should be rendered. The latter two values may be
--   @-1@ in which case the width and height are taken from
--   @pb@. The image is placed at @destX@, @destY@.
--   If you render parts of an image at a time, set @ditherX@ and
--   @ditherY@ to the origin of the image you are rendering.
--
-- * Since 2.2.
--
drawPixbuf :: DrawableClass d => d -> GC -> Pixbuf -> Int -> Int ->
				 Int -> Int -> Int -> Int -> Dither ->
				 Int -> Int -> IO ()
drawPixbuf d gc pb srcX srcY destX destY srcWidth srcHeight dither
  xDither yDither = {#call unsafe draw_pixbuf#} (toDrawable d)
    gc pb (fromIntegral srcX) (fromIntegral srcY) (fromIntegral destX)
    (fromIntegral destY) (fromIntegral srcWidth) (fromIntegral srcHeight)
    ((fromIntegral . fromEnum) dither) (fromIntegral xDither)
    (fromIntegral yDither)

#endif

-- | Draw several unconnected lines.
--
-- * This method draws several unrelated lines.
--
drawSegments :: DrawableClass d => d -> GC -> [(Point,Point)] -> IO ()
drawSegments d gc []  = return ()
drawSegments d gc pps = withArray (concatMap (\((x1,y1),(x2,y2)) -> 
  [fromIntegral x1, fromIntegral y1, fromIntegral x2, fromIntegral y2])
  pps) $ \(aPtr :: Ptr {#type gint#}) ->
    {#call unsafe draw_segments#} (toDrawable d) (toGC gc)
    (castPtr aPtr) (fromIntegral (length pps))

-- | Draw a rectangular object.
--
-- * Draws a rectangular outline or filled rectangle, using the
--   foreground color and other attributes of the 'GC'.
--
-- * A rectangle drawn filled is 1 pixel smaller in both dimensions
--   than a rectangle outlined. Calling 'drawRectangle' w gc
--   True 0 0 20 20 results in a filled rectangle 20 pixels wide and 20
--   pixels high. Calling 'drawRectangle' d gc False 0 0 20 20
--   results in an outlined rectangle with corners at (0, 0), (0, 20), (20,
--   20), and (20, 0), which makes it 21 pixels wide and 21 pixels high.
--
drawRectangle :: DrawableClass d => d -> GC -> Bool -> Int -> Int ->
				       Int -> Int -> IO ()
drawRectangle d gc filled x y width height = {#call unsafe draw_rectangle#}
  (toDrawable d) (toGC gc) (fromBool filled) (fromIntegral x)
  (fromIntegral y) (fromIntegral width) (fromIntegral height)

-- | Draws an arc or a filled 'pie slice'.
--
-- * The arc is defined by the bounding rectangle of the entire
--   ellipse, and the start and end angles of the part of the ellipse to be
--   drawn.
--
-- * The starting angle @aStart@ is relative to the 3 o'clock
--   position, counter-clockwise, in 1\/64ths of a degree. @aEnd@
--   is measured similarly, but relative to @aStart@.
--
drawArc :: DrawableClass d => d -> GC -> Bool -> Int -> Int ->
				 Int -> Int -> Int -> Int -> IO ()
drawArc d gc filled x y width height aStart aEnd =
  {#call unsafe draw_arc#} (toDrawable d) (toGC gc) (fromBool filled)
  (fromIntegral x) (fromIntegral y) (fromIntegral width) (fromIntegral height)
  (fromIntegral aStart) (fromIntegral aEnd)

-- | Draws an outlined or filled polygon.
--
-- * The polygon is closed automatically, connecting the last point to
--   the first point if necessary.
--
drawPolygon :: DrawableClass d => d -> GC -> Bool -> [Point] -> IO ()
drawPolygon _ _ _ [] = return ()
drawPolygon d gc filled points = 
  withArray (concatMap (\(x,y) -> [fromIntegral x, fromIntegral y]) points) $
  \(aPtr::Ptr {#type gint#}) -> {#call unsafe draw_polygon#} (toDrawable d)
  (toGC gc) (fromBool filled) (castPtr aPtr) (fromIntegral (length points))

-- | Draw a single line of text.
--
-- * The @x@ coordinate specifies the start of the string,
--   the @y@ coordinate specifies the base line.
--
drawLayoutLine :: DrawableClass d => d -> GC -> Int -> Int -> LayoutLine ->
				     IO ()
drawLayoutLine d gc x y text =
  {#call unsafe draw_layout_line#} (toDrawable d) (toGC gc)
    (fromIntegral x) (fromIntegral y) text

-- | Draw a single line of text.
--
-- * The @x@ coordinate specifies the start of the string,
--   the @y@ coordinate specifies the base line.
--
-- * If both colors are @Nothing@ this function will behave like
--   'drawLayoutLine' in that it uses the default colors from
--   the graphics context.
--
drawLayoutLineWithColors :: DrawableClass d => d -> GC -> Int -> Int ->
			    LayoutLine -> Maybe Color -> Maybe Color -> IO ()
drawLayoutLineWithColors d gc x y text foreground background = let
    withMB :: Storable a => Maybe a -> (Ptr a -> IO b) -> IO b
    withMB Nothing f = f nullPtr
    withMB (Just x) f = with x f
  in
    withMB foreground $ \fPtr -> withMB background $ \bPtr ->
    {#call unsafe draw_layout_line_with_colors#} (toDrawable d) (toGC gc)
      (fromIntegral x) (fromIntegral y) text (castPtr fPtr) (castPtr bPtr)


-- | Draw a paragraph of text.
--
-- * The @x@ and @y@ values specify the upper left
--   point of the layout. 
--
drawLayout :: DrawableClass d => d -> GC -> Int -> Int -> PangoLayout -> IO ()
drawLayout d gc x y text =
  {#call unsafe draw_layout#} (toDrawable d) (toGC gc)
    (fromIntegral x) (fromIntegral y) (toPangoLayout text)

-- | Draw a paragraph of text.
--
-- * The @x@ and @y@ values specify the upper left
--   point of the layout. 
--
-- * If both colors are @Nothing@ this function will behave like
--   'drawLayout' in that it uses the default colors from
--   the graphics context.
--
drawLayoutWithColors :: DrawableClass d => d -> GC -> Int -> Int ->
			PangoLayout -> Maybe Color -> Maybe Color -> IO ()
drawLayoutWithColors d gc x y text foreground background = let
    withMB :: Storable a => Maybe a -> (Ptr a -> IO b) -> IO b
    withMB Nothing f = f nullPtr
    withMB (Just x) f = with x f
  in
    withMB foreground $ \fPtr -> withMB background $ \bPtr ->
    {#call unsafe draw_layout_with_colors#} (toDrawable d) (toGC gc)
      (fromIntegral x) (fromIntegral y) (toPangoLayout text)
      (castPtr fPtr) (castPtr bPtr)


-- | Copies another 'Drawable'.
--
-- * Copies the (width,height) region of the @src@ at coordinates
--   (@xSrc@, @ySrc@) to coordinates (@xDest@,
--   @yDest@) in the @dest@. The @width@ and\/or
--   @height@ may be given as -1, in which case the entire source
--   drawable will be copied.
--
-- * Most fields in @gc@ are not used for this operation, but
--   notably the clip mask or clip region will be honored.  The source and
--   destination drawables must have the same visual and colormap, or
--   errors will result. (On X11, failure to match visual\/colormap results
--   in a BadMatch error from the X server.)  A common cause of this
--   problem is an attempt to draw a bitmap to a color drawable. The way to
--   draw a bitmap is to set the bitmap as a clip mask on your
--   'GC', then use 'drawRectangle' to draw a 
--   rectangle clipped to the bitmap.
--
drawDrawable :: (DrawableClass src, DrawableClass dest) => 
		dest -> GC -> src -> Int -> Int -> Int -> Int -> 
		Int -> Int -> IO ()
drawDrawable dest gc src xSrc ySrc xDest yDest width height =
  {#call unsafe draw_drawable#} (toDrawable dest) (toGC gc)
  (toDrawable src)
  (fromIntegral xSrc) (fromIntegral ySrc) (fromIntegral xDest)
  (fromIntegral yDest) (fromIntegral width) (fromIntegral height)

[Gtk2hs-commit] gtk2hs/gtk/buttons Button.chs.cpp,NONE,1.1 Button.chspp,1.1,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/buttons
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24829/gtk/buttons

Added Files:
	Button.chs.cpp 
Removed Files:
	Button.chspp 
Log Message:
Enhance makefile so that it builds the library. Changed .chspp to .chs.cpp in
all pre-processed chs files. Build with ghc --make the first time and with
ghc -c on incremental changes.


--- NEW FILE: Button.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Button
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:38 $
--
--  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.
--
-- |
--
module Button(
  Button,
  ButtonClass,
  castToButton,
  buttonNew,
  buttonNewWithLabel,
  buttonNewWithMnemonic,
  buttonNewFromStock,
  buttonPressed,
  buttonReleased,
  buttonClicked,
  buttonEnter,
  buttonLeave,
  ReliefStyle(..),
  buttonSetRelief,
  buttonGetRelief,
  buttonSetLabel,
  buttonGetLabel,
  buttonSetUseStock,
  buttonGetUseStock,
  buttonSetUseUnderline,
  buttonGetUseUnderline,
#if GTK_CHECK_VERSION(2,4,0)
  buttonSetFocusOnClick,
  buttonGetFocusOnClick,
  buttonSetAlignment,
  buttonGetAlignment,
#endif
  onButtonActivate,
  afterButtonActivate,
  onClicked,
  afterClicked,
  onEnter,
  afterEnter,
  onLeave,
  afterLeave,
  onPressed,
  afterPressed,
  onReleased,
  afterReleased
  ) where

import Monad	(liftM)
import FFI

import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}
import Enums	(ReliefStyle(..))

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

-- methods

-- | Create a new Button widget.
--
buttonNew :: IO Button
buttonNew  = makeNewObject mkButton $ liftM castPtr {#call unsafe button_new#}


-- | Create a button with a label in it.
--
buttonNewWithLabel :: String -> IO Button
buttonNewWithLabel lbl = withUTFString lbl (\strPtr ->
  makeNewObject mkButton $ liftM castPtr $
  {#call unsafe button_new_with_label#} strPtr)

-- | Create a button with an accelerator key.
--
-- * Like 'buttonNewWithLabel' but turns every underscore in the
--   label to a underlined character which then acts as a mnemonic (keyboard
--   shortcut).
--
buttonNewWithMnemonic :: String -> IO Button
buttonNewWithMnemonic lbl = withUTFString lbl (\strPtr ->
  makeNewObject mkButton $ liftM castPtr $ 
  {#call unsafe button_new_with_mnemonic#} strPtr)

-- | Create a stock (predefined appearance) button.
--
buttonNewFromStock :: String -> IO Button
buttonNewFromStock stockId = withUTFString stockId (\strPtr -> 
  makeNewObject mkButton $ liftM castPtr $
  throwIfNull "buttonNewFromStock: Invalid stock identifier." $ 
  {#call unsafe button_new_from_stock#} strPtr)

-- | Depress the button, i.e. emit the pressed signal.
--
buttonPressed :: ButtonClass b => b -> IO ()
buttonPressed b = {#call button_pressed#} (toButton b)

-- | Release the button, i.e. emit the released signal.
--
buttonReleased :: ButtonClass b => b -> IO ()
buttonReleased b = {#call button_released#} (toButton b)

-- | Emit the clicked signal on the button.
--
-- * This is similar to calling 'buttonPressed' and
--   'buttonReleased' in sequence.
--
buttonClicked :: ButtonClass b => b -> IO ()
buttonClicked b = {#call button_clicked#} (toButton b)

-- | Emit the cursor enters signal to the button.
--
buttonEnter :: ButtonClass b => b -> IO ()
buttonEnter b = {#call button_enter#} (toButton b)

-- | Emit the cursor leaves signal to the button.
--
buttonLeave :: ButtonClass b => b -> IO ()
buttonLeave b = {#call button_leave#} (toButton b)

-- | Set the style of the button edges.
--
buttonSetRelief :: ButtonClass b => b -> ReliefStyle -> IO ()
buttonSetRelief b rs = 
  {#call button_set_relief#} (toButton b) ((fromIntegral.fromEnum) rs)

-- | Get the current relief style.
--
buttonGetRelief :: ButtonClass b => b -> IO ReliefStyle
buttonGetRelief b = liftM (toEnum.fromIntegral) $
  {#call unsafe button_get_relief#} (toButton b)

-- | Set the text of the button.
--
buttonSetLabel :: ButtonClass b => b -> String -> IO ()
buttonSetLabel b lbl = withUTFString lbl $ \strPtr ->
  {#call button_set_label#} (toButton b) strPtr

-- | Get the current text on the button.
--
-- * The method returns the empty string in case the button does not have
--   a label (e.g. it was created with 'buttonNew'.
--
buttonGetLabel :: ButtonClass b => b -> IO String
buttonGetLabel b = do
  strPtr <- {#call unsafe button_get_label#} (toButton b)
  if strPtr==nullPtr then return "" else peekUTFString strPtr

-- | Set if the label is a stock identifier.
--
-- * Setting this property to @True@ will make the button lookup
--   its label in the table of stock items. If there is a match, the button
--   will use the stock item instead of the label.  You need to set this
--   flag before you change the label.
--
buttonSetUseStock :: ButtonClass b => b -> Bool -> IO ()
buttonSetUseStock b flag = 
  {#call button_set_use_stock#} (toButton b) (fromBool flag)

-- | Get the current flag for stock lookups.
--
buttonGetUseStock :: ButtonClass b => b -> IO Bool
buttonGetUseStock b = liftM toBool $
  {#call unsafe button_get_use_stock#} (toButton b)

-- | Set if the label has accelerators.
--
-- * Setting this property will make the button join any underline character
--   into the following letter and inserting this letter as a keyboard
--   shortcut. You need to set this flag before you change the label.
--
buttonSetUseUnderline :: ButtonClass b => b -> Bool -> IO ()
buttonSetUseUnderline b flag = 
  {#call button_set_use_underline#} (toButton b) (fromBool flag)

-- | Query if the underlines are mnemonics.
--
buttonGetUseUnderline :: ButtonClass b => b -> IO Bool
buttonGetUseUnderline b = liftM toBool $
  {#call unsafe button_get_use_underline#} (toButton b)

#if GTK_CHECK_VERSION(2,4,0)
-- | Sets whether the button will grab focus when it is clicked with the mouse.
--
buttonSetFocusOnClick :: ButtonClass b => b -> Bool -> IO ()
buttonSetFocusOnClick b focus =
  {#call unsafe button_set_focus_on_click#} (toButton b) (fromBool focus)

-- | Gets whether the button grabs focus when it is clicked with the mouse.
--
buttonGetFocusOnClick :: ButtonClass b => b -> IO Bool
buttonGetFocusOnClick b = liftM toBool $
  {#call unsafe button_get_focus_on_click#} (toButton b)

-- | Sets the alignment of the child. This has no effect unless the child
--   derives from "Misc" "Aligment".
--
buttonSetAlignment :: ButtonClass b => b -> (Float, Float) -> IO ()
buttonSetAlignment b (xalign, yalign) =
  {#call unsafe button_set_alignment#} (toButton b)
    (realToFrac xalign) (realToFrac yalign)

-- | Gets the alignment of the child in the button.
--
buttonGetAlignment :: ButtonClass b => b -> IO (Float, Float)
buttonGetAlignment b =
  alloca $ \xalignPtr -> alloca $ \yalignPtr -> do
  {#call unsafe button_get_alignment#} (toButton b) xalignPtr yalignPtr
  xalign <- peek xalignPtr
  yalign <- peek yalignPtr
  return (realToFrac xalign, realToFrac yalign)
#endif


-- signals

-- | The button has been depressed (but not
-- necessarily released yet). See @clicked@ signal.
--
onButtonActivate, afterButtonActivate :: ButtonClass b => b -> IO () ->
                                         IO (ConnectId b)
onButtonActivate = connect_NONE__NONE "activate"  False
afterButtonActivate = connect_NONE__NONE "activate"  True

-- | The button was clicked. This is only emitted if
-- the mouse cursor was over the button when it was released.
--
onClicked, afterClicked :: ButtonClass b => b -> IO () -> IO (ConnectId b)
onClicked = connect_NONE__NONE "clicked" False
afterClicked = connect_NONE__NONE "clicked" True

-- | The cursor enters the button box.
--
onEnter, afterEnter :: ButtonClass b => b -> IO () -> IO (ConnectId b)
onEnter = connect_NONE__NONE "enter" False
afterEnter = connect_NONE__NONE "enter" True

-- | The cursor leaves the button box.
--
onLeave, afterLeave :: ButtonClass b => b -> IO () -> IO (ConnectId b)
onLeave = connect_NONE__NONE "leave" False
afterLeave = connect_NONE__NONE "leave" True

-- | The button is pressed.
--
onPressed, afterPressed :: ButtonClass b => b -> IO () -> IO (ConnectId b)
onPressed = connect_NONE__NONE "pressed" False
afterPressed = connect_NONE__NONE "pressed" True


-- | The button is released.
--
onReleased, afterReleased :: ButtonClass b => b -> IO () -> IO (ConnectId b)
onReleased = connect_NONE__NONE "released" False
afterReleased = connect_NONE__NONE "released" True










--- Button.chspp DELETED ---

[Gtk2hs-commit] gtk2hs/gtk/abstract ButtonBox.chs.cpp,NONE,1.1 FileChooser.chs.cpp,NONE,1.1 Object.chs.cpp,NONE,1.1 Paned.chs.cpp,NONE,1.1 ButtonBox.chspp,1.1,NONE FileChooser.chspp,1.1,NONE Object.chspp,1.1,NONE Paned.chspp,1.1,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/abstract
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24829/gtk/abstract

Added Files:
	ButtonBox.chs.cpp FileChooser.chs.cpp Object.chs.cpp 
	Paned.chs.cpp 
Removed Files:
	ButtonBox.chspp FileChooser.chspp Object.chspp Paned.chspp 
Log Message:
Enhance makefile so that it builds the library. Changed .chspp to .chs.cpp in
all pre-processed chs files. Build with ghc --make the first time and with
ghc -c on incremental changes.


--- Paned.chspp DELETED ---

--- NEW FILE: Paned.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Paned
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:38 $
--
--  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.
--
-- |
--
-- This abstract widget provides a division line with a handle that can be
-- used by the user to divide the given space between two widgets. The two
-- concrete implementations are HPaned and VPaned.
--
module Paned(
  Paned,
  PanedClass,
  castToPaned,
  panedAdd1,
  panedAdd2,
  panedPack1,
  panedPack2,
  panedSetPosition,
  panedGetPosition
#if GTK_CHECK_VERSION(2,4,0)
 ,panedGetChild1,
  panedGetChild2
#endif
  ) where

import Monad	(liftM)
import FFI

import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}

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

-- methods

-- | Add a widget to the first (top or left) area.
--
-- * The widget does not expand if 'Paned' expands. It does not shrink either.
--
panedAdd1 :: (PanedClass p, WidgetClass w) => p -> w -> IO ()
panedAdd1 p w = {#call paned_add1#} (toPaned p) (toWidget w)

-- | Add a widget to the second (bottom or right) area.
--
-- * The widget does not expand if 'Paned' expands. But it does shrink.
--
panedAdd2 :: (PanedClass p, WidgetClass w) => p -> w -> IO ()
panedAdd2 p w = {#call paned_add2#} (toPaned p) (toWidget w)

-- | Add a widget to the first area and specify its resizing behaviour.
--
panedPack1 :: (PanedClass p, WidgetClass w) => p -> w -> Bool -> Bool -> IO ()
panedPack1 p w expand shrink = {#call paned_pack1#} 
  (toPaned p) (toWidget w) (fromBool expand) (fromBool shrink)

-- | Add a widget to the second area and specify its resizing behaviour.
--
panedPack2 :: (PanedClass p, WidgetClass w) => p -> w -> Bool -> Bool -> IO ()
panedPack2 p w expand shrink = {#call paned_pack2#} 
  (toPaned p) (toWidget w) (fromBool expand) (fromBool shrink)

-- | Set the gutter to the specified @position@ (in pixels).
--
panedSetPosition :: PanedClass p => p -> Int -> IO ()
panedSetPosition p position = 
  {#call paned_set_position#} (toPaned p) (fromIntegral position)

-- | Get the gutter position (in pixels).
--
panedGetPosition :: PanedClass p => p -> IO Int
panedGetPosition p = liftM fromIntegral $
  {#call unsafe paned_get_position#} (toPaned p)

#if GTK_CHECK_VERSION(2,4,0)
-- | Obtains the first child of the paned widget.
--
panedGetChild1 :: PanedClass p => p -> IO Widget
panedGetChild1 p =
  makeNewObject mkWidget $ {#call unsafe paned_get_child1#} (toPaned p)

-- | Obtains the second child of the paned widget.
--
panedGetChild2 :: PanedClass p => p -> IO Widget
panedGetChild2 p =
  makeNewObject mkWidget $ {#call unsafe paned_get_child2#} (toPaned p)
#endif

--- NEW FILE: FileChooser.chs.cpp ---
-- GIMP Toolkit (GTK) Binding for Haskell: binding to GConf   -*-haskell-*-
--    for storing and retrieving configuartion information
--
--  Author : Duncan Coutts
--  Created: 24 April 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
--  The file chooser dialog and widget is a replacement
--  for the old "FileSel"ection dialog. It provides a better user
--  interface and an improved API.
--
--  The FileChooser (as opposed to the dialog or widget) is the interface that
--  the "FileChooserDialog" and "FileChooserWidget" implement, all the operations
--  except construction are on this interface.
--
-- * Added in GTK+ 2.4
--
module FileChooser (
#if GTK_CHECK_VERSION(2,4,0)
  FileChooserClass,
  FileChooser,
  FileChooserAction(..),
  fileChooserSetAction,
  fileChooserGetAction,
  fileChooserSetLocalOnly,
  fileChooserGetLocalOnly,
  fileChooserSetSelectMultiple,
  fileChooserGetSelectMultiple,
  fileChooserSetCurrentName,
  fileChooserGetFilename,
  fileChooserSetFilename,
  fileChooserSelectFilename,
  fileChooserUnselectFilename,
  fileChooserSelectAll,
  fileChooserUnselectAll,
  fileChooserGetFilenames,
  fileChooserSetCurrentFolder,
  fileChooserGetCurrentFolder,
  fileChooserGetURI,
  fileChooserSetURI,
  fileChooserSelectURI,
  fileChooserUnselectURI,
  fileChooserGetURIs,
  fileChooserSetCurrentFolderURI,
  fileChooserGetCurrentFolderURI,
  fileChooserSetPreviewWidget,
  fileChooserGetPreviewWidget,
  fileChooserSetPreviewWidgetActive,
  fileChooserGetPreviewWidgetActive,
  fileChooserSetUsePreviewLabel,
  fileChooserGetUsePreviewLabel,
  fileChooserGetPreviewFilename,
  fileChooserGetPreviewURI,
  fileChooserSetExtraWidget,
  fileChooserGetExtraWidget,
  fileChooserAddFilter,
  fileChooserRemoveFilter,
  fileChooserListFilters,
  fileChooserSetFilter,
  fileChooserGetFilter,
  fileChooserAddShortcutFolder,
  fileChooserRemoveShortcutFolder,
  fileChooserlistShortcutFolders,
  fileChooserAddShortcutFolderURI,
  fileChooserRemoveShortcutFolderURI,
  fileChooserListShortcutFolderURIs,
  onCurrentFolderChanged,
  afterCurrentFolderChanged,
  onFileActivated,
  afterFileActivated,
--  onSelectionChanged,
--  afterSelectionChanged,
  onUpdatePreview,
  afterUpdatePreview
#endif
) where

#if GTK_CHECK_VERSION(2,4,0)

import Monad (liftM, when)
import FFI
{#import Hierarchy#}
import Object		(makeNewObject)
import Signal
{#import GList#}
import GError (propagateGError, GErrorDomain, GErrorClass(..))

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

{# enum FileChooserAction {underscoreToCase} #}
{# enum FileChooserError {underscoreToCase} #}

fileChooserErrorDomain :: GErrorDomain
fileChooserErrorDomain = unsafePerformIO {#call unsafe file_chooser_error_quark#}
                                                                                                         
instance GErrorClass FileChooserError where
  gerrorDomain _ = fileChooserErrorDomain

fileChooserSetAction :: FileChooserClass chooser => chooser -> FileChooserAction -> IO ()
fileChooserSetAction chooser action =
  {# call gtk_file_chooser_set_action #} (toFileChooser chooser)
    (fromIntegral $ fromEnum action)

fileChooserGetAction :: FileChooserClass chooser => chooser ->  IO FileChooserAction
fileChooserGetAction chooser = liftM (toEnum . fromIntegral) $
  {# call gtk_file_chooser_get_action #} (toFileChooser chooser)

fileChooserSetLocalOnly :: FileChooserClass chooser => chooser -> Bool -> IO ()
fileChooserSetLocalOnly chooser localOnly = 
  {# call gtk_file_chooser_set_local_only #} (toFileChooser chooser)
    (fromBool localOnly)

fileChooserGetLocalOnly :: FileChooserClass chooser => chooser -> IO Bool
fileChooserGetLocalOnly chooser = liftM toBool $
  {# call gtk_file_chooser_get_local_only #} (toFileChooser chooser)

fileChooserSetSelectMultiple :: FileChooserClass chooser => chooser -> Bool -> IO ()
fileChooserSetSelectMultiple chooser selectMultiple = 
  {# call gtk_file_chooser_set_select_multiple #} (toFileChooser chooser)
    (fromBool selectMultiple)

fileChooserGetSelectMultiple :: FileChooserClass chooser => chooser -> IO Bool
fileChooserGetSelectMultiple chooser = liftM toBool $
  {# call gtk_file_chooser_get_select_multiple #} (toFileChooser chooser)

fileChooserSetCurrentName :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserSetCurrentName chooser name =
  withCString name $ \strPtr ->
  {# call gtk_file_chooser_set_current_name #} (toFileChooser chooser) strPtr

fileChooserGetFilename :: FileChooserClass chooser => chooser -> IO (Maybe String)
fileChooserGetFilename chooser = do
  strPtr <- {# call gtk_file_chooser_get_filename #} (toFileChooser chooser)
  maybePeek readCString strPtr

fileChooserSetFilename :: FileChooserClass chooser => chooser -> String -> IO Bool
fileChooserSetFilename chooser filename = liftM toBool $
  withCString filename $ \strPtr ->
  {# call gtk_file_chooser_set_filename #} (toFileChooser chooser) strPtr

fileChooserSelectFilename :: FileChooserClass chooser => chooser -> String -> IO Bool
fileChooserSelectFilename chooser filename = liftM toBool $
  withCString filename $ \strPtr ->
  {# call gtk_file_chooser_select_filename #} (toFileChooser chooser) strPtr

fileChooserUnselectFilename :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserUnselectFilename chooser filename = 
  withCString filename $ \strPtr ->
  {# call gtk_file_chooser_unselect_filename #} (toFileChooser chooser) strPtr

fileChooserSelectAll :: FileChooserClass chooser => chooser -> IO ()
fileChooserSelectAll chooser = 
  {# call gtk_file_chooser_select_all #} (toFileChooser chooser)

fileChooserUnselectAll :: FileChooserClass chooser => chooser -> IO ()
fileChooserUnselectAll chooser = 
  {# call gtk_file_chooser_unselect_all #} (toFileChooser chooser)

fileChooserGetFilenames :: FileChooserClass chooser => chooser -> IO [String]
fileChooserGetFilenames chooser = do
  strList <- {# call gtk_file_chooser_get_filenames #} (toFileChooser chooser)
  fromStringGSList strList

fileChooserSetCurrentFolder :: FileChooserClass chooser => chooser -> String -> IO Bool
fileChooserSetCurrentFolder chooser foldername = liftM toBool $
  withCString foldername $ \strPtr ->
  {# call gtk_file_chooser_set_current_folder #} (toFileChooser chooser) strPtr

fileChooserGetCurrentFolder :: FileChooserClass chooser => chooser -> IO (Maybe String)
fileChooserGetCurrentFolder chooser = do
  strPtr <- {# call gtk_file_chooser_get_current_folder #} (toFileChooser chooser)
  maybePeek readCString strPtr

fileChooserGetURI :: FileChooserClass chooser => chooser -> IO (Maybe String)
fileChooserGetURI chooser = do
  strPtr <- {# call gtk_file_chooser_get_uri #} (toFileChooser chooser)
  maybePeek readCString strPtr

fileChooserSetURI :: FileChooserClass chooser => chooser -> String -> IO Bool
fileChooserSetURI chooser uri = liftM toBool $
  withCString uri $ \strPtr ->
  {# call gtk_file_chooser_set_uri #} (toFileChooser chooser) strPtr

fileChooserSelectURI :: FileChooserClass chooser => chooser -> String -> IO Bool
fileChooserSelectURI chooser uri = liftM toBool $
  withCString uri $ \strPtr ->
  {# call gtk_file_chooser_select_uri #} (toFileChooser chooser) strPtr

fileChooserUnselectURI :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserUnselectURI chooser uri = 
  withCString uri $ \strPtr ->
  {# call gtk_file_chooser_unselect_uri #} (toFileChooser chooser) strPtr

fileChooserGetURIs :: FileChooserClass chooser => chooser -> IO [String]
fileChooserGetURIs chooser = do
  strList <- {# call gtk_file_chooser_get_uris #} (toFileChooser chooser)
  fromStringGSList strList

fileChooserSetCurrentFolderURI :: FileChooserClass chooser => chooser -> String -> IO Bool
fileChooserSetCurrentFolderURI chooser uri = liftM toBool $
  withCString uri $ \strPtr ->
  {# call gtk_file_chooser_set_current_folder_uri #} (toFileChooser chooser) strPtr

fileChooserGetCurrentFolderURI :: FileChooserClass chooser => chooser -> IO String
fileChooserGetCurrentFolderURI chooser = do
  strPtr <- {# call gtk_file_chooser_get_current_folder_uri #} (toFileChooser chooser)
  readCString strPtr

fileChooserSetPreviewWidget :: (FileChooserClass chooser, WidgetClass widget) =>
                               chooser -> widget -> IO ()
fileChooserSetPreviewWidget chooser widget = 
  {# call gtk_file_chooser_set_preview_widget #} (toFileChooser chooser)
    (toWidget widget)

fileChooserGetPreviewWidget :: FileChooserClass chooser => chooser -> IO (Maybe Widget)
fileChooserGetPreviewWidget chooser = do
  ptr <- {# call gtk_file_chooser_get_preview_widget #} (toFileChooser chooser)
  maybePeek (makeNewObject mkWidget . return) ptr

fileChooserSetPreviewWidgetActive :: FileChooserClass chooser => chooser -> Bool -> IO ()
fileChooserSetPreviewWidgetActive chooser active = 
  {# call gtk_file_chooser_set_preview_widget_active #} (toFileChooser chooser)
    (fromBool active)

fileChooserGetPreviewWidgetActive :: FileChooserClass chooser => chooser -> IO Bool
fileChooserGetPreviewWidgetActive chooser = liftM toBool $
  {# call gtk_file_chooser_get_preview_widget_active #} (toFileChooser chooser)

fileChooserSetUsePreviewLabel :: FileChooserClass chooser => chooser -> Bool -> IO ()
fileChooserSetUsePreviewLabel chooser usePreview = 
  {# call gtk_file_chooser_set_use_preview_label #} (toFileChooser chooser)
    (fromBool usePreview)

fileChooserGetUsePreviewLabel :: FileChooserClass chooser => chooser -> IO Bool
fileChooserGetUsePreviewLabel chooser = liftM toBool $
  {# call gtk_file_chooser_get_use_preview_label #} (toFileChooser chooser)

fileChooserGetPreviewFilename :: FileChooserClass chooser => chooser -> IO (Maybe String)
fileChooserGetPreviewFilename chooser = do
  strPtr <- {# call gtk_file_chooser_get_preview_filename #} (toFileChooser chooser)
  maybePeek readCString strPtr

fileChooserGetPreviewURI :: FileChooserClass chooser => chooser -> IO (Maybe String)
fileChooserGetPreviewURI chooser = do
  strPtr <- {# call gtk_file_chooser_get_preview_uri #} (toFileChooser chooser)
  maybePeek readCString strPtr

fileChooserSetExtraWidget :: (FileChooserClass chooser, WidgetClass widget) =>
                             chooser -> widget -> IO ()
fileChooserSetExtraWidget chooser widget = 
  {# call gtk_file_chooser_set_extra_widget #} (toFileChooser chooser)
    (toWidget widget)

fileChooserGetExtraWidget :: FileChooserClass chooser => chooser -> IO (Maybe Widget)
fileChooserGetExtraWidget chooser = do
  ptr <- {# call gtk_file_chooser_get_extra_widget #} (toFileChooser chooser)
  maybePeek (makeNewObject mkWidget . return) ptr

fileChooserAddFilter :: FileChooserClass chooser => chooser -> FileFilter -> IO ()
fileChooserAddFilter chooser filter = 
  {# call gtk_file_chooser_add_filter #} (toFileChooser chooser) filter

fileChooserRemoveFilter :: FileChooserClass chooser => chooser -> FileFilter -> IO ()
fileChooserRemoveFilter chooser filter = 
  {# call gtk_file_chooser_remove_filter #} (toFileChooser chooser) filter

fileChooserListFilters :: FileChooserClass chooser => chooser -> IO [FileFilter]
fileChooserListFilters chooser = do
  filterList <- {# call gtk_file_chooser_list_filters #} (toFileChooser chooser)
  filterPtrs <- fromGSList filterList
  mapM (makeNewObject mkFileFilter . return) filterPtrs

fileChooserSetFilter :: FileChooserClass chooser => chooser -> FileFilter -> IO ()
fileChooserSetFilter chooser filter = 
  {# call gtk_file_chooser_set_filter #} (toFileChooser chooser) filter

fileChooserGetFilter :: FileChooserClass chooser => chooser -> IO (Maybe FileFilter)
fileChooserGetFilter chooser = do
  ptr <- {# call gtk_file_chooser_get_filter #} (toFileChooser chooser)
  maybePeek (makeNewObject mkFileFilter . return) ptr

fileChooserAddShortcutFolder :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserAddShortcutFolder chooser foldername =
  propagateGError $ \gerrorPtr ->
  withCString foldername $ \strPtr -> do
  {# call gtk_file_chooser_add_shortcut_folder #} (toFileChooser chooser)
    strPtr gerrorPtr
  return ()

fileChooserRemoveShortcutFolder :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserRemoveShortcutFolder chooser foldername =
  propagateGError $ \gerrorPtr ->
  withCString foldername $ \strPtr -> do
  {# call gtk_file_chooser_remove_shortcut_folder #} (toFileChooser chooser)
    strPtr gerrorPtr
  return ()

fileChooserlistShortcutFolders :: FileChooserClass chooser => chooser -> IO [String]
fileChooserlistShortcutFolders chooser = do
  strList <- {# call gtk_file_chooser_list_shortcut_folders #}
    (toFileChooser chooser)
  fromStringGSList strList

fileChooserAddShortcutFolderURI :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserAddShortcutFolderURI chooser folderuri =
  propagateGError $ \gerrorPtr ->
  withCString folderuri $ \strPtr -> do
  {# call gtk_file_chooser_add_shortcut_folder_uri #} (toFileChooser chooser)
    strPtr gerrorPtr
  return ()

fileChooserRemoveShortcutFolderURI :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserRemoveShortcutFolderURI chooser folderuri =
  propagateGError $ \gerrorPtr ->
  withCString folderuri $ \strPtr -> do
  {# call gtk_file_chooser_remove_shortcut_folder_uri #}
    (toFileChooser chooser) strPtr gerrorPtr
  return ()

fileChooserListShortcutFolderURIs :: FileChooserClass chooser => chooser -> IO [String]
fileChooserListShortcutFolderURIs chooser = do
  strList <- {# call gtk_file_chooser_list_shortcut_folder_uris #}
    (toFileChooser chooser)
  fromStringGSList strList

onCurrentFolderChanged, afterCurrentFolderChanged :: FileChooserClass c => c -> IO () -> IO (ConnectId c)
onCurrentFolderChanged = connect_NONE__NONE "current-folder-changed" False
afterCurrentFolderChanged = connect_NONE__NONE "current-folder-changed" True

onFileActivated, afterFileActivated :: FileChooserClass c => c -> IO () -> IO (ConnectId c)
onFileActivated = connect_NONE__NONE "file-activated" False
afterFileActivated = connect_NONE__NONE "file-activated" True

--onSelectionChanged, afterSelectionChanged :: FileChooserClass c => c -> IO () -> IO (ConnectId c)
--onSelectionChanged = connect_NONE__NONE "selection-changed" False
--afterSelectionChanged = connect_NONE__NONE "selection-changed" True

onUpdatePreview, afterUpdatePreview :: FileChooserClass c => c -> IO () -> IO (ConnectId c)
onUpdatePreview = connect_NONE__NONE "update-preview" False
afterUpdatePreview = connect_NONE__NONE "update-preview" True


------------------------------------------------------
-- Utility functions that really ought to go elsewhere

-- convenience functions for GSlists of strings
fromStringGSList :: GSList -> IO [String]
fromStringGSList strList = do
  strPtrs <- fromGSList strList
  mapM readCString strPtrs

toStringGSList :: [String] -> IO GSList
toStringGSList strs = do
  strPtrs <- mapM newCString strs
  toGSList strPtrs

#endif


--- ButtonBox.chspp DELETED ---

--- Object.chspp DELETED ---

--- NEW FILE: Object.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Object
--
--  Author : Axel Simon
--          
--  Created: 9 April 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:38 $
--
--  Copyright (c) 2001 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.
--
-- |
--
-- Widget representation
--
-- * Each widget is a represented as a purely abstract data type. It can only 
--   be accessed through and the special access functions that are defined
--   in each widget file.
--
module Object(
  Object,
  ObjectClass,
  castToObject,
  objectSink,
  makeNewObject,
  objectSetProperty,
  objectGetProperty
  ) where

import FFI

import GObject		(objectRef, objectUnref)
{#import Signal#}
{#import Hierarchy#}
{#import GValue#}
import StoreValue

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

-- methods

-- turn the initial floating state to sunk
--
-- * The floating\/sunk concept of a GTK object is not very useful to us.
--   The following procedure circumvents the whole subject and ensures 
--   proper cleanup:
--     on creation:      objectRef, objectSink
--     on finalization:  objectUnref
--
-- * This function cannot be bound by c2hs because it is not possible to
--   override the pointer hook.
objectSink :: ObjectClass obj => Ptr obj -> IO ()
objectSink = object_sink.castPtr

#if __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gtk_object_sink"
  object_sink :: Ptr Object -> IO ()

#else

foreign import ccall "gtk_object_sink" unsafe 
  object_sink :: Ptr Object -> IO ()

#endif

-- This is a convenience function to generate a new widget. It adds the
-- finalizer with the method described under objectSink.
--
-- * The constr argument is the contructor of the specific object.
--
makeNewObject :: ObjectClass obj => 
  (ForeignPtr obj -> obj) -> IO (Ptr obj) -> IO obj
makeNewObject constr generator = do
  objPtr <- generator
  objectRef objPtr
  obj <- newForeignPtr objPtr (objectUnref objPtr)
  objectSink objPtr
  return $ constr obj


-- Sets a specific attribute of this object.
--
-- * Most attributes in a widget can be set and retrieved by passing the
--   name (as a string) and the value to special set\/get functions. These
--   are undocumented because each derived objects implements custom (and
--   welltyped) set and get functions for most attributes.
--
objectSetProperty :: GObjectClass gobj => gobj -> String -> GenericValue -> 
					  IO ()
objectSetProperty obj prop val = alloca $ \vaPtr -> withUTFString prop $ 
  \sPtr -> poke vaPtr val >> {#call unsafe g_object_set_property#} 
  (toGObject obj) sPtr vaPtr >> valueUnset vaPtr
  

-- Gets a specific attribute of this object.
--
-- * See 'objectSetProperty'.
--
objectGetProperty :: GObjectClass gobj => gobj -> String -> 
					IO GenericValue
objectGetProperty obj prop = alloca $ \vaPtr -> withUTFString prop $ \str -> do
  {#call unsafe g_object_get_property#} (toGObject obj) str vaPtr
  res <- peek vaPtr
  valueUnset vaPtr
  return res


--- FileChooser.chspp DELETED ---

--- NEW FILE: ButtonBox.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget ButtonBox
--
--  Author : Matthew Walton
--          
--  Created: 28 April 2004
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:38 $
--
--  Copyright (c) 2004 Matthew Walton
--
--  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.
--
-- |
--
module ButtonBox(
  ButtonBox,
  ButtonBoxClass,
  castToButtonBox,
  buttonBoxGetLayout,
  buttonBoxSetLayout,
  buttonBoxSetChildSecondary,
#if GTK_CHECK_VERSION(2,4,0)
  buttonBoxGetChildSecondary
#endif
  ) where

import Monad (liftM)
import FFI

import Object (makeNewObject)
{#import Hierarchy#}
{#import Signal#}

import Enums (ButtonBoxStyle)

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

-- methods

-- | Retrieve the method being used to
-- arrange the buttons in the button box
--
buttonBoxGetLayout :: ButtonBoxClass b => b -> IO ButtonBoxStyle
buttonBoxGetLayout b = liftM (toEnum . fromIntegral) $
  {#call gtk_button_box_get_layout#} (toButtonBox b)

#if GTK_CHECK_VERSION(2,4,0)
-- | Returns whether child should appear
-- in a secondary group of children
--
-- * Since Gtk 2.4.
buttonBoxGetChildSecondary :: (ButtonBoxClass b, WidgetClass w) => b -> w -> IO Bool
buttonBoxGetChildSecondary b w = liftM toBool $
  {#call gtk_button_box_get_child_secondary#} (toButtonBox b) (toWidget w)
#endif

-- | Changes the way buttons are arranged in their container
--
buttonBoxSetLayout :: ButtonBoxClass b => b -> ButtonBoxStyle -> IO ()
buttonBoxSetLayout b l =
  {#call gtk_button_box_set_layout#} (toButtonBox b)
    ((fromIntegral . fromEnum) l)

-- | Sets whether child should appear in a secondary
-- group of children. A typical use of a secondary child is the help button in a dialog.
--
-- * This group appears after the other children if the style is 'ButtonboxStart',
-- 'ButtonboxSpread' or 'ButtonboxEdge', and before the the other children if the
-- style is 'ButtonboxEnd'. For horizontal button boxes, the definition of before\/after
-- depends on direction of the widget (see 'widgetSetDirection'). If the style is
-- 'buttonBoxStart' or 'buttonBoxEnd', then the secondary children are aligned at
-- the other end of the button box from the main children. For the other styles,
-- they appear immediately next to the main children.
--
buttonBoxSetChildSecondary :: (ButtonBoxClass b, WidgetClass w) => b -> w -> Bool -> IO ()
buttonBoxSetChildSecondary b w s =
  {#call gtk_button_box_set_child_secondary #} (toButtonBox b) (toWidget w)
    (fromBool s)

[Gtk2hs-commit] gtk2hs/.deps - New directory

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/.deps
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32269/.deps

Log Message:
Directory /cvsroot/gtk2hs/gtk2hs/.deps added to the repository

[Gtk2hs-commit] gtk2hs ChangeLog,1.229,1.230 Makefile.am,1.1,1.2 configure.ac,1.1,1.2 aclocal.m4,1.5,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15131

Modified Files:
	ChangeLog Makefile.am configure.ac 
Removed Files:
	aclocal.m4 
Log Message:
Force automake to link object file in subdirs, not in the toplevel one.


--- aclocal.m4 DELETED ---

Index: configure.ac
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/configure.ac,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- configure.ac	24 Oct 2004 17:19:18 -0000	1.1
+++ configure.ac	25 Oct 2004 08:49:40 -0000	1.2
@@ -530,7 +530,6 @@
 AC_OUTPUT([
   Makefile
   gtk2hs.spec
-  mk/config.mk
   mk/chsDepend
   c2hs/toplevel/C2HSConfig.hs
 ],[chmod a+x mk/chsDepend && chmod a+x install-sh])

Index: Makefile.am
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/Makefile.am,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- Makefile.am	24 Oct 2004 17:19:18 -0000	1.1
+++ Makefile.am	25 Oct 2004 08:49:40 -0000	1.2
@@ -40,7 +40,6 @@
 
 lib_LIBRARIES = libgtk2hs.a
 
-
 libgtk2hs_a_SOURCES = \
 	gtk/general/Hierarchy.chs \
 	gtk/general/Signal.chs \
@@ -175,6 +174,9 @@
 	compat/LocalControl.hs \
 	compat/LocalData.hs
 
+am_libgtk2hs_a_OBJECTS = \
+  $(addsuffix .$(OBJEXT),$(basename $(libgtk2hs_a_SOURCES)))
+
 libgtk2hs_a_CHSFILES = $(filter %.chs %.chspp, $(libgtk2hs_a_SOURCES))
 libgtk2hs_a_CHSFILES_HS = $(patsubst %.chs,%.hs,\
 	$(patsubst %.chspp,%.hs,$(libgtk2hs_a_CHSFILES)))

Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.229
retrieving revision 1.230
diff -u -d -r1.229 -r1.230
--- ChangeLog	24 Oct 2004 17:19:18 -0000	1.229
+++ ChangeLog	25 Oct 2004 08:49:39 -0000	1.230
@@ -1,3 +1,13 @@
+2004-10-25  Axel Simon <A....@ke...>
+
+	* configure.ac: Don't update mk/config.mk.in which no longer
+	exists.
+
+	* Makefile.am: Repair automake: Force object files to be in
+	subdirectories.
+
+	* aclocal.m4: Removed. This file is regenerated automatically.
+	
 2004-10-24  Axel Simon <A....@ke...>
 
 	* configure.in, configure.ac, Makefile, Makefile.am: Removed old

[Gtk2hs-commit] gtk2hs/gtk/general Enums.chspp,NONE,1.1 IconFactory.chspp,NONE,1.1 Gtk.hs,1.28,1.29 Enums.chs,1.9,NONE IconFactory.chs,1.7,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/general
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28086/gtk/general

Modified Files:
	Gtk.hs 
Added Files:
	Enums.chspp IconFactory.chspp 
Removed Files:
	Enums.chs IconFactory.chs 
Log Message:
New build system.


--- IconFactory.chs DELETED ---

Index: Gtk.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/general/Gtk.hs,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -d -r1.28 -r1.29
--- Gtk.hs	8 Aug 2004 19:04:39 -0000	1.28
+++ Gtk.hs	24 Oct 2004 17:19:21 -0000	1.29
@@ -39,7 +39,7 @@
 --
 -- * Every module that is commented out and not mentioned above.
 --
-#include <gtk/gtkversion.h>
+#include <config.h>
 
 module Gtk(
   -- * General things, initialization

--- NEW FILE: IconFactory.chspp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) IconFactory
--
--  Author : Axel Simon
--          
--  Created: 24 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/24 17:19:21 $
--
--  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.
--
-- |
--
-- This module provides access to IconFactory, IconSet and IconSource.
--
-- TODO
--
-- * The following functions are not bound:
--   iconFactoryLookup, iconFactoryLookupDefault
--   It is not a good idea to lookup an IconSet directly. If an Icon needs to
--   be displayed it happends always in the context of a widget. The best
--   practice is to get the widgets Style and call styleLookupIconSet.
--
module IconFactory(
  IconFactory,
  iconFactoryNew,
  iconFactoryAdd,
  iconFactoryAddDefault,
  iconFactoryLookup,
  iconFactoryLookupDefault,
  iconFactoryRemoveDefault,
  IconSet,
  iconSetNew,
  iconSetNewFromPixbuf,
  iconSetAddSource,
  iconSetRenderIcon,
  iconSetGetSizes,
  IconSource,
  iconSourceNew,
  TextDirection(..),
  iconSourceGetDirection,
  iconSourceSetDirection,
  iconSourceResetDirection,
  iconSourceGetFilename,
  iconSourceSetFilename,
  iconSourceGetPixbuf,
  iconSourceSetPixbuf,
  iconSourceGetSize,
  iconSourceSetSize,
  iconSourceResetSize,
  StateType(..),
  iconSourceGetState,
  iconSourceSetState,
  iconSourceResetState,
  IconSize,
  iconSizeMenu,
  iconSizeSmallToolbar,
  iconSizeLargeToolbar,
  iconSizeButton,
  iconSizeDialog,
  iconSizeCheck,
  iconSizeRegister,
  iconSizeRegisterAlias,
  iconSizeFromName,
  iconSizeGetName
  ) where

import Monad	(liftM)
import FFI
import GObject	(makeNewGObject)
{#import Hierarchy#}
{#import Signal#}
import Enums	(TextDirection(..), StateType(..))
import Structs	(IconSize, iconSizeInvalid, iconSizeMenu, iconSizeSmallToolbar,
		 iconSizeLargeToolbar, iconSizeButton, iconSizeDialog)

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

{#pointer *IconSource foreign newtype#}

{#pointer *IconSet foreign newtype#}

-- methods


-- | Add an IconSet to an IconFactory.
--
-- * In order to use the new stock object, the factory as to be added to the
--   default factories by iconFactoryAddDefault.
--
iconFactoryAdd :: IconFactory -> String -> IconSet -> IO ()
iconFactoryAdd i stockId iconSet = withUTFString stockId $ \strPtr ->
  {#call unsafe icon_factory_add#} i strPtr iconSet

-- | Add all entries of the IconFactory to the
-- applications stock object database.
--
iconFactoryAddDefault :: IconFactory -> IO ()
iconFactoryAddDefault  = {#call unsafe icon_factory_add_default#}

-- | Looks up the stock id in the icon factory, returning an icon set if found,
-- otherwise Nothing.
--
-- * For display to the user, you should use 'styleLookupIconSet' on the "Style"
-- for the widget that will display the icon, instead of using this function
-- directly, so that themes are taken into account.
--
iconFactoryLookup :: IconFactory -> String -> IO (Maybe IconSet)
iconFactoryLookup i stockId =
  withUTFString stockId $ \strPtr -> do
  iconSetPtr <- {#call unsafe icon_factory_lookup#} i strPtr
  if iconSetPtr == nullPtr then return Nothing else liftM (Just . IconSet) $
    newForeignPtr iconSetPtr (icon_set_unref iconSetPtr)

-- | Looks for an icon in the list of default icon factories.
--
-- * For display to the user, you should use 'styleLookupIconSet' on the "Style"
-- for the widget that will display the icon, instead of using this function
-- directly, so that themes are taken into account.
--
iconFactoryLookupDefault :: String -> IO (Maybe IconSet)
iconFactoryLookupDefault stockId =
  withUTFString stockId $ \strPtr -> do
  iconSetPtr <- {#call unsafe icon_factory_lookup_default#} strPtr
  if iconSetPtr == nullPtr then return Nothing else liftM (Just . IconSet) $
    newForeignPtr iconSetPtr (icon_set_unref iconSetPtr)

-- | Create a new IconFactory.
--
-- * An application should create a new 'IconFactory' and add all
--   needed icons.
--   By calling 'iconFactoryAddDefault' these icons become
--   available as stock objects and can easily be displayed by
--   'Image'. Furthermore, a theme can override the icons defined by
--   the application.
--
iconFactoryNew :: IO IconFactory
iconFactoryNew  = makeNewGObject mkIconFactory {#call unsafe icon_factory_new#}

-- | Remove an IconFactory from the
-- application's stock database.
--
iconFactoryRemoveDefault :: IconFactory -> IO ()
iconFactoryRemoveDefault  = {#call unsafe icon_factory_remove_default#}

-- | Add an 'IconSource' (an Icon with
-- attributes) to an 'IconSet'.
--
-- * If an icon is looked up in the IconSet @set@ the best matching
--   IconSource will be taken. It is therefore advisable to add a default
--   (wildcarded) icon, than can be used if no exact match is found.
--
iconSetAddSource :: IconSet -> IconSource -> IO ()
iconSetAddSource set source = {#call unsafe icon_set_add_source#} set source

iconSetRenderIcon :: WidgetClass widget => IconSet
                  -> TextDirection
                  -> StateType
                  -> IconSize
                  -> widget
                  -> IO Pixbuf
iconSetRenderIcon set dir state size widget = makeNewGObject mkPixbuf $
  {#call icon_set_render_icon#} set (Style nullForeignPtr)
    ((fromIntegral.fromEnum) dir) ((fromIntegral.fromEnum) state)
    ((fromIntegral.fromEnum) size) (toWidget widget) nullPtr

-- | Create a new IconSet.
--
-- * Each icon in an application is contained in an 'IconSet'. The
--   'IconSet' contains several variants ('IconSource's) to
--   accomodate for different sizes and states.
--
iconSetNew :: IO IconSet
iconSetNew  = do
  isPtr <- {#call unsafe icon_set_new#}
  liftM IconSet $ newForeignPtr isPtr (icon_set_unref isPtr)

-- | Creates a new 'IconSet' with the given pixbuf as the default\/fallback
-- source image. If you don't add any additional "IconSource" to the icon set,
-- all variants of the icon will be created from the pixbuf, using scaling,
-- pixelation, etc. as required to adjust the icon size or make the icon look
-- insensitive\/prelighted.
--
iconSetNewFromPixbuf :: Pixbuf -> IO IconSet
iconSetNewFromPixbuf pixbuf = do
  isPtr <- {#call unsafe icon_set_new_from_pixbuf#} pixbuf
  liftM IconSet $ newForeignPtr isPtr (icon_set_unref isPtr)

-- | Obtains a list of icon sizes this icon set can render.
--
iconSetGetSizes :: IconSet -> IO [IconSize]
iconSetGetSizes set =
  alloca $ \sizesArrPtr -> alloca $ \lenPtr -> do
  {#call unsafe icon_set_get_sizes#} set sizesArrPtr lenPtr
  len <- peek lenPtr
  sizesArr <- peek sizesArrPtr
  list <- peekArray (fromIntegral len) sizesArr
  {#call unsafe g_free#} (castPtr sizesArr)
  return $ map (toEnum.fromIntegral) list

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&gtk_icon_set_unref"
  icon_set_unref' :: FinalizerPtr IconSet

icon_set_unref :: Ptr IconSet -> FinalizerPtr IconSet
icon_set_unref _ = icon_set_unref'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gtk_icon_set_unref"
  icon_set_unref :: Ptr IconSet -> IO ()

#else

foreign import ccall "gtk_icon_set_unref" unsafe
  icon_set_unref :: Ptr IconSet -> IO ()

#endif


-- | Check if a given IconSize is registered.
--
-- * Useful if your application expects a theme to install a set with a
--   specific size. You can test if this actually happend and use another size
--   if not.
--
iconSizeCheck :: IconSize -> IO Bool
iconSizeCheck size = liftM toBool $
  {#call icon_size_lookup#} (fromIntegral size) nullPtr nullPtr

-- | Register a new IconSize.
--
iconSizeRegister :: Int -> String -> Int -> IO IconSize
iconSizeRegister height name width = liftM fromIntegral $
  withUTFString name $ \strPtr -> {#call unsafe icon_size_register#} 
  strPtr (fromIntegral width) (fromIntegral height)

-- | Register an additional alias for a name.
--
iconSizeRegisterAlias :: IconSize -> String -> IO ()
iconSizeRegisterAlias target alias = withUTFString alias $ \strPtr ->
  {#call unsafe icon_size_register_alias#} strPtr (fromIntegral target)

-- | Lookup an IconSize by name.
--
-- * This fixed value 'iconSizeInvalid' is returned if the name was
--   not found.
--
iconSizeFromName :: String -> IO IconSize
iconSizeFromName name = liftM fromIntegral $
  withUTFString name {#call unsafe icon_size_from_name#}

-- | Lookup the name of an IconSize.
--
-- * Returns @Nothing@ if the name was not found.
--
iconSizeGetName :: IconSize -> IO (Maybe String)
iconSizeGetName size = do
  strPtr <- {#call unsafe icon_size_get_name#} (fromIntegral size)
  if strPtr==nullPtr then return Nothing else liftM Just $ peekUTFString strPtr

-- | Retrieve the 'TextDirection' of
-- this IconSource.
--
-- * @Nothing@ is returned if no explicit direction was set.
--
iconSourceGetDirection :: IconSource -> IO (Maybe TextDirection)
iconSourceGetDirection is = do
  res <- {#call icon_source_get_direction_wildcarded#} is
  if (toBool res) then return Nothing else liftM (Just .toEnum.fromIntegral) $
    {#call unsafe icon_source_get_direction#} is

-- | Retrieve the filename this IconSource was
-- based on.
--
-- * Returns @Nothing@ if the IconSource was generated by a Pixbuf.
--
iconSourceGetFilename :: IconSource -> IO (Maybe String)
iconSourceGetFilename is = do
  strPtr <- {#call unsafe icon_source_get_filename#} is
  if strPtr==nullPtr then return Nothing else liftM Just $ peekUTFString strPtr

-- | Retrieve the 'IconSize' of this
-- IconSource.
--
-- * @Nothing@ is returned if no explicit size was set (i.e. this
--   'IconSource' matches all sizes).
--
iconSourceGetSize :: IconSource -> IO (Maybe IconSize)
iconSourceGetSize is = do
  res <- {#call unsafe icon_source_get_size_wildcarded#} is
  if (toBool res) then return Nothing else liftM (Just .fromIntegral) $
    {#call unsafe icon_source_get_size#} is

-- | Retrieve the 'StateType' of this
-- 'IconSource'.
--
-- * @Nothing@ is returned if the 'IconSource' matches all 
--   states.
--
iconSourceGetState :: IconSource -> IO (Maybe StateType)
iconSourceGetState is = do
  res <- {#call unsafe icon_source_get_state_wildcarded#} is
  if (toBool res) then return Nothing else liftM (Just .toEnum.fromIntegral) $
    {#call unsafe icon_source_get_state#} is

-- | Create a new IconSource.
--
-- * An IconSource is a single image that is usually added to an IconSet. Next
--   to the image it contains information about which state, text direction
--   and size it should apply.
--
iconSourceNew :: IO IconSource
iconSourceNew  = do
  isPtr <- {#call unsafe icon_source_new#}
  liftM IconSource $ newForeignPtr isPtr (icon_source_free isPtr)

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&gtk_icon_source_free"
  icon_source_free' :: FinalizerPtr IconSource

icon_source_free :: Ptr IconSource -> FinalizerPtr IconSource
icon_source_free _ = icon_source_free'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gtk_icon_source_free"
  icon_source_free :: Ptr IconSource -> IO ()

#else

foreign import ccall "gtk_icon_source_free" unsafe
  icon_source_free :: Ptr IconSource -> IO ()

#endif


-- | Mark this 'IconSource' that it
-- should only apply to the specified 'TextDirection'.
--
iconSourceSetDirection :: IconSource -> TextDirection -> IO ()
iconSourceSetDirection is td = do
  {#call unsafe icon_source_set_direction_wildcarded#} is (fromBool False)
  {#call unsafe icon_source_set_direction#} is ((fromIntegral.fromEnum) td)

-- | Reset the specific
-- 'TextDirection' set with 'iconSourceSetDirection'.
--
iconSourceResetDirection is =
  {#call unsafe icon_source_set_direction_wildcarded#} is (fromBool True)

-- | Load an icon picture from this filename.
--
iconSourceSetFilename :: IconSource -> FilePath -> IO ()
iconSourceSetFilename is name = 
  withUTFString name $ {#call unsafe icon_source_set_filename#} is

-- | Retrieves the source pixbuf, or Nothing if none is set.
--
iconSourceGetPixbuf :: IconSource -> IO (Maybe Pixbuf)
iconSourceGetPixbuf is = do
  pixbufPtr <- {#call unsafe icon_source_get_pixbuf#} is
  if pixbufPtr==nullPtr then return Nothing else liftM Just $
    makeNewGObject mkPixbuf (return pixbufPtr)

-- | Sets a pixbuf to use as a base image when creating icon variants for
-- 'IconSet'.
--
iconSourceSetPixbuf :: IconSource -> Pixbuf -> IO ()
iconSourceSetPixbuf is pb = do
  {#call icon_source_set_pixbuf#} is pb

-- | Set this 'IconSource' to a specific
-- size.
--
iconSourceSetSize :: IconSource -> IconSize -> IO ()
iconSourceSetSize is size = do
  {#call unsafe icon_source_set_size_wildcarded#} is (fromBool False)
  {#call unsafe icon_source_set_size#} is (fromIntegral size)

-- | Reset the 'IconSize' of this
-- 'IconSource' so that is matches anything.
--
iconSourceResetSize :: IconSource -> IO ()
iconSourceResetSize is = 
  {#call unsafe icon_source_set_size_wildcarded#} is (fromBool True)

-- | Mark this icon to be used only with this
-- specific state.
--
iconSourceSetState :: IconSource -> StateType -> IO ()
iconSourceSetState is state = do
  {#call unsafe icon_source_set_state_wildcarded#} is (fromBool False)
  {#call unsafe icon_source_set_state#} is ((fromIntegral.fromEnum) state)

-- | Reset the 'StateType' of this
-- 'IconSource' so that is matches anything.
--
iconSourceResetState :: IconSource -> IO ()
iconSourceResetState is = 
  {#call unsafe icon_source_set_state_wildcarded#} is (fromBool True)





--- Enums.chs DELETED ---

--- NEW FILE: Enums.chspp ---
--  -*-haskell-*-
--  GIMP Toolkit (GTK) Enumerations
--
--  Author : Axel Simon, Manuel Chakravarty
--  Created: 13 Januar 1999
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/24 17:19:21 $
--
--  Copyright (c) [1999..2001] Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- General enumeration types.
--
-- TODO
--
--  * Documentation
--
module Enums(
  AccelFlags(..),
  ArrowType(..),
  AttachOptions(..),
  Button(..),
  ButtonBoxStyle(..),
  CalendarDisplayOptions(..),
  Click(..),
  CornerType(..),
  CurveType(..),
  DeleteType(..),
  DirectionType(..),
  Justification(..),
#ifndef DISABLE_DEPRECATED
  MatchType(..),
#endif
  MenuDirectionType(..),
  MetricType(..),
  MovementStep(..),
  Orientation(..),
  Packing(..),
  PackType(..),
  PathPriorityType(..),
  PathType(..),
  PolicyType(..),
  PositionType(..),
  ProgressBarOrientation(..),
  ReliefStyle(..),
  ResizeMode(..),
  ScrollType(..),
  SelectionMode(..),
  ShadowType(..),
  StateType(..),
#ifndef DISABLE_DEPRECATED
  SubmenuDirection(..),
  SubmenuPlacement(..),
#endif
  SpinButtonUpdatePolicy(..),
  SpinType(..),
  TextDirection(..),
  TextSearchFlags(..),
  TextWindowType(..),
  ToolbarStyle(..),
  TreeViewColumnSizing(..),
  --TroughType(..),
  UpdateType(..),
  Visibility(..),
  WindowPosition(..),
  WindowType(..),
  WrapMode(..), 
  SortType(..),
  module GdkEnums
  ) where

import GdkEnums

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


-- | state of an accelerator
--
{#enum AccelFlags {underscoreToCase} deriving(Bounded)#}

instance Flags AccelFlags

-- | arrow directions for the arrow widget
--
{#enum ArrowType {underscoreToCase}#}

-- | child widget attach options for table containers
--
{#enum AttachOptions {underscoreToCase} deriving(Bounded)#}

instance Flags AttachOptions

-- | button number
--
data Button = LeftButton
	    | MiddleButton
	    | RightButton
	    | WheelUp
	    | WheelDown
	    | OtherButton

instance Enum Button where
  toEnum 1 = LeftButton
  toEnum 2 = MiddleButton
  toEnum 3 = RightButton
  toEnum 4 = WheelUp
  toEnum 5 = WheelDown
  toEnum _ = OtherButton
  fromEnum LeftButton   = 1
  fromEnum MiddleButton = 2
  fromEnum RightButton  = 3
  fromEnum WheelUp	= 4
  fromEnum WheelDown	= 5
  fromEnum OtherButton	= 6

-- | dictate the style that a ButtonBox uses to align it
-- contents
--
{#enum ButtonBoxStyle {underscoreToCase}#}

-- | Specify which items of a calendar should be
-- displayed.
--
{#enum CalendarDisplayOptions {underscoreToCase} deriving(Bounded)#}

instance Flags CalendarDisplayOptions

-- | type of mouse click
--
data Click = SingleClick
	   | DoubleClick
	   | TripleClick
	   | ReleaseClick

-- | specifies in which corner a child widget should be placed
--
{#enum CornerType {underscoreToCase}#}

-- | specifies how curves in the gamma widget (?) are drawn
--
{#enum CurveType {underscoreToCase}#}

-- | editing option
--
{#enum DeleteType {underscoreToCase}#}

-- | editing direction
--
{#enum DirectionType {underscoreToCase}#}

-- | justification for label and maybe other widgets
-- (text?)
--
{#enum Justification {underscoreToCase}#}

#ifndef DISABLE_DEPRECATED
-- | some kind of string search options
--
{#enum MatchType {underscoreToCase}#}
#endif

-- | From where was a menu item entered?
--
{#enum MenuDirectionType {underscoreToCase}#}

-- | units of measure
--
{#enum MetricType {underscoreToCase}#}

-- | movement in text widget
--
{#enum MovementStep {underscoreToCase}#}

-- | orientation is good
--
{#enum Orientation {underscoreToCase}#}

-- | packing parameters of a widget
--
data Packing = PackRepel
	     | PackGrow
	     | PackNatural
	     deriving (Enum,Eq)

-- packing of widgets at start or end in a box
--
{#enum PackType {underscoreToCase}#}

-- | priorities
--
{#enum PathPriorityType {underscoreToCase}#}

-- | widget identification path
--
{#enum PathType {underscoreToCase}#}

-- | Scrollbar policy types (for scrolled windows)
--
{#enum PolicyType {underscoreToCase}#}

-- | position a scale's value is drawn relative to the
-- trough
--
{#enum PositionType {underscoreToCase}#}

-- | Is the ProgressBar horizontally or vertically
-- directed?
--
{#enum ProgressBarOrientation {underscoreToCase}#}

-- | I don't have a clue.
--
{#enum ReliefStyle {underscoreToCase}#}

-- | resize mode, for containers
--
-- * 'ResizeParent' Pass resize request to the parent
--
-- * 'ResizeQueue' Queue resizes on this widget
--
-- * 'ResizeImmediate' Perform the resizes now
--
{#enum ResizeMode {underscoreToCase}#}

-- | scrolling type
--
{#enum ScrollType {underscoreToCase}#}

-- | mode in which selections can be performed
--
-- * There is a deprecated entry SelectionExtended which should have the same
--   value as SelectionMultiple. C2HS chokes on that construct.
--
data SelectionMode = SelectionNone
                   | SelectionSingle
                   | SelectionBrowse
                   | SelectionMultiple
                   deriving (Enum)
-- {#enum SelectionMode {underscoreToCase}#}

-- | shadow types
--
{#enum ShadowType {underscoreToCase}#}

-- | widget states
--
{#enum StateType {underscoreToCase}#}

#ifndef DISABLE_DEPRECATED
-- | Submenu direction policies
--
{#enum SubmenuDirection {underscoreToCase}#}

-- | Submenu placement policies
--
{#enum SubmenuPlacement {underscoreToCase}#}
#endif

-- | Whether to clamp or ignore illegal values.
--
{#enum SpinButtonUpdatePolicy {underscoreToCase}#}

-- | Spin a SpinButton with the following method.
--
{#enum SpinType {underscoreToCase}#}

-- | Is the text written from left to right or the awkward
-- way?
--
{#enum TextDirection {underscoreToCase}#}

-- | Specify the way the search function for
-- 'TextBuffer' works.
--
{#enum TextSearchFlags {underscoreToCase} deriving(Bounded)#}

instance Flags TextSearchFlags

-- | The window type for coordinate translation.
--
{#enum TextWindowType {underscoreToCase}#}

-- | Where to place the toolbar?
--
{#enum ToolbarStyle {underscoreToCase}#}

-- | Wether columns of a tree or list widget can be
-- resized.
--
{#enum TreeViewColumnSizing {underscoreToCase}#}

-- hm... text editing?
--{#enum TroughType {underscoreToCase}#}


-- | updating types for range widgets (determines when the
-- @\"connectToValueChanged\"@ signal is emitted by the widget)
--
{#enum UpdateType {underscoreToCase}#}

-- | visibility
--
{#enum Visibility {underscoreToCase}#}

-- | window position types
--
{#enum WindowPosition {underscoreToCase}#}

-- | interaction of a window with window manager
--
{#enum WindowType {underscoreToCase}#}

-- | Determine how lines are wrapped in a 'TextView'.
--
{#enum WrapMode {underscoreToCase}#}

-- sort in ascending or descending order (used in CList widget)
--
{#enum SortType {underscoreToCase}#}

[Gtk2hs-commit] gtk2hs Makefile.am,NONE,1.1 configure.ac,NONE,1.1 ChangeLog,1.228,1.229 TODO,1.5,1.6 aclocal.m4,1.4,1.5 Makefile,1.34,NONE configure.in,1.44,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28086

Modified Files:
	ChangeLog TODO aclocal.m4 
Added Files:
	Makefile.am configure.ac 
Removed Files:
	Makefile configure.in 
Log Message:
New build system.


--- NEW FILE: configure.ac ---
dnl Mogul - a monad based gui library
dnl
dnl Copyright (c) 2001, 2002 Axel Simon <as...@uk...>
dnl with parts stolen from Manuel Chakravaty, Sven Panne and Micheal Weber
dnl
dnl This library is free software; you can redistribute it and/or
dnl modify it under the terms of the GNU Library General Public
dnl License as published by the Free Software Foundation; either
dnl version 2 of the License, or (at your option) any later version.
dnl 
dnl This library is distributed in the hope that it will be useful,
dnl but WITHOUT ANY WARRANTY; without even the implied warranty of
dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
dnl Library General Public License for more details.
dnl 
dnl You should have received a copy of the GNU Library General Public
dnl License along with this library (COPYING.LIB); if not, write to the Free
dnl Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

dnl ######################################################################
dnl Process this file with autoconf to produce a configure script.
dnl ######################################################################

AC_INIT(VERSION)
AM_INIT_AUTOMAKE(gtk2hs, 0.9.9)

dnl * We require autoconf version 2.50
dnl We need 2.50 due to the use of OBJEXT 
AC_PREREQ(2.50)

dnl Check system type.
AC_CANONICAL_HOST

AC_CONFIG_HEADERS(config.h)
AH_TOP([#include<gtk/gtkversion.h>])

dnl Checks for programs.
AC_PROG_CC
AC_PROG_CPP
AC_PROG_INSTALL
AC_PROG_LN_S
AC_PATH_PROG(AR,ar)
AC_PATH_PROG(BASENAME,basename)
AC_PATH_PROG(GREP,gnugrep)
AC_PATH_PROG(GREP,ggrep)
AC_PATH_PROG(GREP,grep)
AC_PATH_PROG(GZIP,gzip)
AC_PATH_PROG(SED,gnused)
AC_PATH_PROG(SED,gsed)
AC_PATH_PROG(SED,sed)
AC_PATH_PROG(TAR,tar)
AC_PATH_PROG(TOUCH,touch)
AC_PROG_RANLIB

dnl On some systems (Solaris,...) asking sh for the current directory
dnl (with a built-in pwd) and asking make for the current directory
dnl gives different results. Thus, if possible, we use the same external
dnl program for determining the current path.
dnl The AC_PATH_PROG macro does not work because pwd is a built-in and
dnl therefore evaluated in the body of the expanded macro.
AC_MSG_CHECKING(for external pwd)
PWD=`which pwd 2> /dev/null`
if test -z "$PWD"; then
  AC_MSG_RESULT([none found])
  PWD="pwd";
else
  AC_MSG_RESULT($PWD)
fi;

dnl Figure out file extensions.
AC_EXEEXT

dnl Check for library pre- and suffixes.
if test x$EXEEXT = x; then
  dnl must be unix
  SLSUFFIX=".a";
  SLPREFIX="lib";
  DLSUFFIX=".so";
  DLPREFIX="lib";
  dnl the hash sign is a comment for sed
  PATHSED=["\#"];
  HSCFLAGS=;
  C2HSFLAGS=" -C-D__signed=signed";
  dnl Where are we? (only used during configuration)
  TOP=`$PWD`;
else
  dnl must be Win32
  SLSUFFIX=".lib";
  SLPREFIX="";
  DLSUFFIX=".dll";
  DLPREFIX="";
  dnl replace something like /c/ with c:/
  case $host_os in
    *cygwin* ) PATHSED=["s+/cygdrive/\([a-z]\)/+\1:/+"];;
    *mingw32* ) PATHSED=["s+/\([a-z]\)/+\1:/+"];;
    * ) PATHSED=["\#"];; 
  esac;
  HSCFLAGS=" -C -optc-fnative-struct";
  C2HSFLAGS=;
  dnl Where are we? (only used during configuration)
  TOP=`$PWD | $SED $PATHSED`;
  WIN32=yes;
fi;

dnl determine a temporary directory for c2hs
TMPDIR="/tmp"
if test "$WIN32" = "yes"; then
  TMPDIR="C:\TMP"
fi
AC_SUBST(TMPDIR)

dnl Check for libraries.

dnl Is Manuels Ports library present?
dnl AC_ARG_WITH(ports, 
dnl	    [  --with-ports=PORTS-CONFIG use this Haskell Ports Library],
dnl	    [PORTS_CONFIG=$withval])


dnl Select a specific Haskell compiler and/or flags.
AC_ARG_WITH(hc, 
            [  --with-hc=HC            use Haskell compiler HC],
	    [HC=$withval])

AC_ARG_WITH(hcflags, 
            [  --with-hcflags=HCFLAGS  flags for Haskell tools, default: -O -H180m],
	    [HCFLAGS=$withval])



dnl Check for GHC-5.04 or greater.
dnl (The next command is not executed, if $HC is already set.)
AC_PATH_PROG(HC, [$HC ghc], ghc-not-found)
if test $HC = ghc-not-found; then
 AC_MSG_ERROR([
Could not find GHC!  This is the only supported compiler.
You need GHC 5.04 upwards.])
fi

GHC=$HC

dnl Check GHC details.
AC_MSG_CHECKING([version of GHC])
GHC_VERSION=`$GHC --version | $SED "s/[[a-zA-Z ,]*\([0-9.]*\)[a-zA-Z ]]*/\1/"`
AC_MSG_RESULT([$GHC_VERSION])

GTKHS_PROG_CHECK_VERSION($GHC_VERSION, -lt, 5.0.4, [
  AC_MSG_ERROR([I need the FFI of GHC 5.04 upwards!])])

dnl Calculate a version number with 3 digits (i.e. 502 for 5.2)
GHC_VERSION_NUMBER=`echo $GHC_VERSION | $SED "s/[[0-9]*\.\([0-9]]*\).*/0\1/"`
GHC_VERSION_NUMBER=`echo $GHC_VERSION_NUMBER | $SED "s/[[0-9]*\([0-9][0-9]]\)/\1/"`
GHC_VERSION_NUMBER=`echo $GHC_VERSION | $SED "s/\([[0-9]]\).*/\1/"`$GHC_VERSION_NUMBER

__GLASGOW_HASKELL__=$GHC_VERSION_NUMBER
AC_DEFINE_UNQUOTED(__GLASGOW_HASKELL__, $GHC_VERSION_NUMBER,
	[Version number of GHC.])

dnl Check if the ghc compiler can generate dynamic callbacks with more than
dnl 4 words worth of arguments. Hopefully one day the compiler will support
dnl this.
AC_MSG_CHECKING([broken dynamic callbacks])
FOUR_WORD_CALLBACK=no
GTKHS_PROG_CHECK_VERSION($GHC_VERSION, -lt, 9.9.9, [
  if test $host_cpu = sparc; then FOUR_WORD_CALLBACK=yes; fi
])
AC_MSG_RESULT([$FOUR_WORD_CALLBACK])

dnl ghc-pkg 5 searches for libxxx.a, even on Windows. Hence, we need to
dnl create libraries with these names instead of the windows names.
GTKHS_PROG_CHECK_VERSION($GHC_VERSION, -lt, 6.0.0, [
  SLSUFFIX=".a";
  SLPREFIX="lib";
  DLSUFFIX=".so";
  DLPREFIX="lib";
])

GHCBARE=`basename $GHC`
GHCDIR=`dirname $GHC`
GHCPKGNAME=ghc-pkg`echo $GHCBARE | $SED s/ghc//`

dnl Check for ghc-pkg. Use the one that is in the same directory and
dnl version suffix as the specified compiler.
AC_PATH_PROGS(GHCPKG, $GHCPKGNAME ghc-pkg, ghcpkg-not-found, $GHCDIR)

if test $GHCPKG = ghcpkg-not-found; then
  AC_MSG_ERROR([ghc-pkg not found. (But ghc exists!?)]);
fi

dnl Determine how to list local packages with ghc-pkg.
GHCPKG_LISTLOCAL="-l";
GTKHS_PROG_CHECK_VERSION($GHC_VERSION, -ge, 6.00.0, [GHCPKG_LISTLOCAL="-L"])

dnl Optimise Haskell by default and give sufficient space.
if test -z "$HCFLAGS"; then
  HCFLAGS=" -O -H180m "
fi


dnl Due to the interdependencies between the different packages we need to
dnl install one package before we can compile the next one. We do this by
dnl using a local package file called localpackage.conf in the toplevel
dnl directory. The user may specify an alternative file and using the complete
dnl suite in-place.
AC_ARG_WITH(pkgconf,
	    [  --with-pkgconf=pkg.conf use another package.conf file for building in-place],
	    [LOCALPKGCONF=$withval],[LOCALPKGCONF='$(TOP)/localpackage.conf'])

dnl Check for pkg-config which holds information about all Gtk related
dnl libraries.
AC_PATH_PROG(PKG_CONFIG, pkg-config, no)

if test "$PKG_CONFIG" = "no" ; then
 AC_MSG_ERROR([*** The pkg-config script could not be found. Make sure it is
   *** in your path, or set the PKG_CONFIG environment variable
   *** to the full path to pkg-config.
   *** Or see http://www.freedesktop.org/software/pkgconfig to get pkg-config.
  ])
fi;


dnl dnl Check if user wants GtkGLExt extension. Make the default value for this
dnl dnl flag dependant on whether it is installed or not.
dnl ENABLE_OPENGL=yes;
dnl AC_MSG_CHECKING([if OpenGL extension can be built])
dnl 
dnl AC_ARG_ENABLE(glext,
dnl 	      [  --enable-glext          generate binding for OpenGL rendering],
dnl 	      [FOUNDGLEXT=$enableval],[FOUNDGLEXT=yes])
dnl 
dnl dnl Reset the flag if GtkGLExt is not installed
dnl $PKG_CONFIG --exists gtkglext-1.0 || FOUNDGLEXT=no;
dnl if test x$FOUNDGLEXT = xno; then ENABLE_OPENGL=no;fi;
dnl 
dnl dnl Reset the flag if HOpenGL is not installed
dnl FOUNDHOPENGL=yes;
dnl $GHCPKG -l | $GREP OpenGL > /dev/null || FOUNDHOPENGL=no;
dnl if test x$FOUNDHOPENGL = xno; then ENABLE_OPENGL=no;fi;
dnl 
dnl AC_MSG_RESULT($ENABLE_OPENGL)

dnl Check if user wants libglade bindings. Defaults to yes.
AC_MSG_CHECKING([whether to build libglade bindings])

AC_ARG_ENABLE(libglade,
              [  --disable-libglade      do not generate libglade bindings],
              [ENABLE_LIBGLADE=$enableval],[ENABLE_LIBGLADE=yes])

AC_MSG_RESULT($ENABLE_LIBGLADE)

dnl Check if user wants the various gnome modules. Defaults to yes.
AC_MSG_CHECKING([whether to build gnome bindings])

AC_ARG_ENABLE(gnome,
              [  --disable-gnome         do not generate bindings for any gnome modules],
              [ENABLE_GNOME=$enableval],[ENABLE_GNOME=yes])

AC_MSG_RESULT($ENABLE_GNOME)

dnl Check for the GTK&Co libraries. Use the special PKG_CHECK_MODULES
dnl macro from the pkg-config program.
PKG_CHECK_MODULES(GTK,[glib-2.0 >= 2.0.0 gdk-2.0 >= 2.0.0 gtk+-2.0 >= 2.0.0 gdk-pixbuf-2.0 >= 0.12.0])
dnl if test x$ENABLE_OPENGL = xyes; then
dnl   PKG_CHECK_MODULES(GTKGLEXT,[gtkglext-1.0 >= 0.7.1])
dnl fi
if test x$ENABLE_LIBGLADE = xyes; then
  PKG_CHECK_MODULES(LIBGLADE,[libglade-2.0 >= 2.0.0])
fi
if test x$ENABLE_GNOME = xyes; then
  PKG_CHECK_MODULES(GCONF,[gconf-2.0 >= 2.0.0])
  PKG_CHECK_MODULES(SOURCEVIEW,[gtksourceview-1.0 >= 0.6.0])
fi

dnl Some APIs only appeared in later versions of libraries, so check if we're
dnl using later than particular versions.
GTK_VERSION_2_2=`$PKG_CONFIG gtk+-2.0 --atleast-version=2.2 && echo yes || echo no`
GTK_VERSION_2_4=`$PKG_CONFIG gtk+-2.0 --atleast-version=2.4 && echo yes || echo no`

dnl The configuration program for GTK is kind of stupid in that it
dnl lists directories which don't exist. ghc-pkg in ghc 5.04 or greater
dnl does not like that, so we need to filter out non-existent directories.
TMPGTK_CFLAGS=$GTK_CFLAGS;
GTK_CFLAGS=;
for FLAG in $TMPGTK_CFLAGS; do
  case $FLAG in
    -I*) DIR=`echo $FLAG | $SED "s/-I//"`;
	 if test -d $DIR; then GTK_CFLAGS="$GTK_CFLAGS -I$DIR"; fi;;
    *) GTK_CFLAGS="$GTK_CFLAGS $FLAG";;
  esac;
done;
TMPGTK_LIBS=$GTK_LIBS;
GTK_LIBS=;
for FLAG in $TMPGTK_LIBS; do
  case $FLAG in
    -L*) DIR=`echo $FLAG | $SED "s/-L//"`;
	 if test -d $DIR; then GTK_LIBS="$GTK_LIBS -L$DIR"; fi;;
    *) GTK_LIBS="$GTK_LIBS $FLAG";;
  esac;
done;

TMPSOURCEVIEW_CFLAGS=$SOURCEVIEW_CFLAGS;
SOURCEVIEW_CFLAGS=;
for FLAG in $TMPSOURCEVIEW_CFLAGS; do
  case $FLAG in
    -I*) DIR=`echo $FLAG | $SED "s/-I//"`;
	 if test -d $DIR; then SOURCEVIEW_CFLAGS="$SOURCEVIEW_CFLAGS -I$DIR"; fi;;
    *) SOURCEVIEW_CFLAGS="$SOURCEVIEW_CFLAGS $FLAG";;
  esac;
done;
TMPSOURCEVIEW_LIBS=$SOURCEVIEW_LIBS;
SOURCEVIEW_LIBS=;
for FLAG in $TMPSOURCEVIEW_LIBS; do
  case $FLAG in
    -L*) DIR=`echo $FLAG | $SED "s/-L//"`;
	 if test -d $DIR; then SOURCEVIEW_LIBS="$SOURCEVIEW_LIBS -L$DIR"; fi;;
    *) SOURCEVIEW_LIBS="$SOURCEVIEW_LIBS $FLAG";;
  esac;
done;

TMPLIBGLADE_CFLAGS=$LIBGLADE_CFLAGS;
LIBGLADE_CFLAGS=;
for FLAG in $TMPLIBGLADE_CFLAGS; do
  case $FLAG in
    -I*) DIR=`echo $FLAG | $SED "s/-I//"`;
	 if test -d $DIR; then LIBGLADE_CFLAGS="$LIBGLADE_CFLAGS -I$DIR"; fi;;
    *) LIBGLADE_CFLAGS="$LIBGLADE_CFLAGS $FLAG";;
  esac;
done;
TMPLIBGLADE_LIBS=$LIBGLADE_LIBS;
LIBGLADE_LIBS=;
for FLAG in $TMPLIBGLADE_LIBS; do
  case $FLAG in
    -L*) DIR=`echo $FLAG | $SED "s/-L//"`;
	 if test -d $DIR; then LIBGLADE_LIBS="$LIBGLADE_LIBS -L$DIR"; fi;;
    *) LIBGLADE_LIBS="$LIBGLADE_LIBS $FLAG";;
  esac;
done;

TMPGCONF_CFLAGS=$GCONF_CFLAGS;
GCONF_CFLAGS=;
for FLAG in $TMPGCONF_CFLAGS; do
  case $FLAG in
    -I*) DIR=`echo $FLAG | $SED "s/-I//"`;
         if test -d $DIR; then GCONF_CFLAGS="$GCONF_CFLAGS -I$DIR"; fi;;
    *) GCONF_CFLAGS="$GCONF_CFLAGS $FLAG";;
  esac;
done;
TMPGCONF_LIBS=$GCONF_LIBS;
GCONF_LIBS=;
for FLAG in $TMPGCONF_LIBS; do
  case $FLAG in
    -L*) DIR=`echo $FLAG | $SED "s/-L//"`;
         if test -d $DIR; then GCONF_LIBS="$GCONF_LIBS -L$DIR"; fi;;
     *) GCONF_LIBS="$GCONF_LIBS $FLAG";;
  esac;
done;

dnl Check if user wants bindings for deprecated APIs. Defaults to yes.
AC_MSG_CHECKING([whether to build deprecated bindings])

AC_ARG_ENABLE(deprecated,
	     [  --disable-deprecated    do not generate bindings for any deprecated APIs],
	     [ENABLE_DEPRECATED=$enableval],[ENABLE_DEPRECATED=yes])

DISABLE_DEPRECATED=`test $ENABLE_DEPRECATED = yes && echo no || echo yes`
AC_MSG_RESULT($ENABLE_DEPRECATED)

if test $DISABLE_DEPRECATED = yes; then
C2HSFLAGS="$C2HSFLAGS -C-DDISABLE_DEPRECATED"
HSCFLAGS="$HSCFLAGS -DDISABLE_DEPRECATED"
fi

dnl Have a special marshall list (available in the source tree of Gtk+ under
dnl gtk/gtkmarshal.list)

AC_MSG_CHECKING(marshal list)
AC_ARG_WITH(mlist, 
	    [  --with-mlist=GTK-SOURCE use special marshall list from GTK+ sources],
	    [MARSHALLDEFS=$withval;
	     AC_MSG_RESULT($withval)],
	    [MARSHALLDEFS='$(TOP)/tools/callbackGen/gtkmarshal.list';
	     AC_MSG_RESULT(built-in)])



dnl c2hs Dilemma.
dnl We provide a local copy of Manuel's c2hs which is patched so that is can
dnl process several .chs files at the same invocation. This patch was not
dnl incooperated into the main c2hs version since Manuel wants to do some
dnl other fundamental changes first. The nice thing is that with the built-in
dnl c2hs this whole package can be built without any other libraries.

dnl Check if the user supplied a specific C->Haskell installation or wants to
dnl use the version in the current search path (--with-c2hs-config=yes). 
dnl The default is to use the built-in version.
AC_ARG_WITH(c2hs, 
  [  --with-c2hs=C2HS        use an external C->Haskell installation (slower!)],
  [
    case $withval in
      yes) {
	BUILT_IN_C2HS=no;
        AC_PATH_PROG(C2HS, c2hs, notfound)
        if test $C2HS = notfound; then
          AC_MSG_ERROR([C->Haskell was not found in current search path.
	          Try compiling with the built-in c2hs by omitting
		  --with-c2hs=... when calling ./configure .])
	fi
	} ;;
      no) {
	BUILT_IN_C2HS=yes
	} ;;
      *) {
	BUILT_IN_C2HS=no;
	AC_PATH_PROG(C2HS, $withval, notfound)
        if test $C2HS = notfound; then
	  AC_MSG_ERROR([The specified C->Haskell tool was not found.
	          Try compiling with the built-in c2hs by omitting
		  --with-c2hs=... when calling ./configure .])
	fi
	} ;;
    esac
  ],[BUILT_IN_C2HS=yes])

dnl The big switch differing between built-in and external c2hs.

AC_MSG_CHECKING([kind of C->Haskell])
if test $BUILT_IN_C2HS = yes; then
  AC_MSG_RESULT([built-in])
  dnl Use the local c2hs.
  C2HS='$(TOP)/c2hs/c2hs';
  MULTIPLE_CHS=yes;

  dnl These are the settings needed to compile c2hs.
  LEGACY_FFI=no;
  BEGIN_LEGACY_FFI="{- for systems including the Legacy FFI";
  END_LEGACY_FFI="-}";
  BEGIN_NEW_FFI=;
  END_NEW_FFI=;
  BEGIN_NHC="{- NHC does some things differently...";
  END_NHC="-}";
  BEGIN_NOT_NHC=;
  END_NOT_NHC=;

else
  AC_MSG_RESULT([external])
  case $C2HS in
    c2hs-gtk2hs) {
      MULTIPLE_CHS=yes;
      } ;;
    *) {
      MULTIPLE_CHS=no;
      dnl Find C->Haskell and check its version.
      dnl Check the version of c2hs
      AC_CACHE_CHECK([c2hs version], c2hs_version, [
        c2hs_version=`$C2HS --version | $SED "s/[[^0-9.]*\([0-9.]*\) .*]/\1/"`;
      ])
      GTKHS_PROG_CHECK_VERSION($c2hs_version, -lt, 0.11.6,
        AC_MSG_ERROR([You need C->Haskell version 0.11.6 upwards!
          ** Download from \"http://www.cse.unsw.edu.au/~chak/haskell/c2hs/\". **]))
      dnl C->Haskell configuration.
      } ;;
  esac;
fi

# Read the version file
VERSION=`cat $TOP/VERSION`

dnl Documentation
AC_PATH_PROG(HADDOCK,haddock)

AC_ARG_WITH(ghc-docdir, 
            [  --with-ghc-docdir=GHC_DOCDIR  location of top of ghc haddockified html documentation],
	    [GHC_DOCDIR=$withval])

dnl Needed substitution.
AC_SUBST(PWD)
AC_SUBST(TOP)
AC_SUBST(BUILT_IN_C2HS)
AC_SUBST(MULTIPLE_CHS)
AC_SUBST(FOUR_WORD_CALLBACK)
AC_SUBST(GHCPKG_LISTLOCAL)
AC_SUBST(LOCALPKGCONF)
AC_SUBST(HCFLAGS)
AC_SUBST(C2HS)
AC_SUBST(MARSHALLDEFS)
AC_SUBST(VERSION)
dnl Platform specific flags 
AC_SUBST(DLPREFIX)
AC_SUBST(DLSUFFIX)
AC_SUBST(SLPREFIX)
AC_SUBST(SLSUFFIX)
AC_SUBST(WIN32)
AC_SUBST(PATHSED)
AC_SUBST(HSCFLAGS)
AC_SUBST(C2HSFLAGS)
AC_SUBST(EXTRA_HFILES)
dnl Versionitis
dnl AC_SUBST(GTK_MAJOR_VERSION)
dnl AC_SUBST(GTK_MINOR_VERSION)
dnl AC_SUBST(GTK_MICRO_VERSION)
AC_SUBST(GTK_VERSION_2_2)
AC_SUBST(GTK_VERSION_2_4)
AC_SUBST(DISABLE_DEPRECATED)
dnl Optional packages
dnl AC_SUBST(ENABLE_OPENGL)
AC_SUBST(ENABLE_LIBGLADE)
AC_SUBST(ENABLE_GNOME)
AC_SUBST(SOURCEVIEW_CFLAGS)
AC_SUBST(SOURCEVIEW_LIBS)
AC_SUBST(LIBGLADE_CFLAGS)
AC_SUBST(LIBGLADE_LIBS)
AC_SUBST(GCONF_CFLAGS)
AC_SUBST(GCONF_LIBS)
dnl Documentation
AC_SUBST(HADDOCK)
AC_SUBST(GHC_DOCDIR)
dnl The c2hs part.
AC_SUBST(CPP)
AC_SUBST(LEGACY_FFI)
AC_SUBST(BEGIN_LEGACY_FFI)
AC_SUBST(END_LEGACY_FFI)
AC_SUBST(BEGIN_NEW_FFI)
AC_SUBST(END_NEW_FFI)
AC_SUBST(BEGIN_NHC)
AC_SUBST(END_NHC)
AC_SUBST(BEGIN_NOT_NHC)
AC_SUBST(END_NOT_NHC)

dnl write the results...
AC_OUTPUT([
  Makefile
  gtk2hs.spec
  mk/config.mk
  mk/chsDepend
  c2hs/toplevel/C2HSConfig.hs
],[chmod a+x mk/chsDepend && chmod a+x install-sh])

dnl ...and chat with the user
echo "**************************************************"
echo "* Configuration completed successfully.          *"
echo "*                                                *"
if test -z "$HADDOCK"; then
	echo "* Warning: The documentation will not be built:  *"
	echo "*   - haddock was not found                      *"
	echo "*                                                *"
fi
dnl if test $BUILDDOCS = no; then
dnl   echo "* Warning: The documentation will not be built:  *"
dnl   if test $FOUNDTRANSLATOR = no; then
dnl     echo "*   - the xsltproc translator was not found      *"
dnl   fi;
dnl   if test $FOUNDCATALOG = no; then
dnl     echo "*   - no XML catalog files were found            *"
dnl   fi;
dnl   if test $FOUNDHTML = no; then
dnl     echo "*   - no HTML XSL translation file was found     *"
dnl   fi;
dnl   if test $FOUNDFO = no; then
dnl     echo "*   - no FO XSL translation file was found       *"
dnl   fi;
dnl   echo "*                                                *"
dnl fi;
dnl if test $ENABLE_OPENGL = no; then
dnl  echo "* Warning: OpenGL support is not available:      *"
dnl  if test x$FOUNDGLEXT = xno; then
dnl    echo "*   - the GtkGLExt widget is not installed       *"
dnl  fi;
dnl  if test x$FOUNDHOPENGL = xno; then
dnl    echo "*   - HOpenGL is not installed in the specified  *"
dnl    echo "*     GHC installation                           *"
dnl  fi;
dnl  echo "*                                                *"
dnl fi;
echo "* Now do \"(g)make\" followed by \"(g)make install\" *"
echo "**************************************************"

--- NEW FILE: Makefile.am ---
AUTOMAKE_OPTIONS = foreign subdir-objects

SUFFIXES = .chspp .chs .hsc

SOURCEDIRS = gtk/general gtk/glib gtk/pango gtk/treeList gtk/multiline \
	gtk/gdk gtk/abstract gtk/display gtk/entry gtk/misc gtk/multiline \
	gtk/ornaments gtk/scrolling gtk/treeList gtk/selectors gtk/embedding \
	compat gtk/layout gtk/menuComboToolbar gtk/buttons gtk/windows

# fixme: this should be in configure.ac:
HSCPP = $(CPP) -x c -traditional-cpp -P

CHSDEPEND = $(srcdir)/mk/chsDepend

HSC = hsc2hs

# Flags for the C compiler and C pre-processor.
# *_CFLAGS variables contain general flags for the C compiler. A subset of
# these, namely just the -I flags, are always available in *_CPPFLAGS.
# Breaking this convention is the automake built-in AM_CPPFLAGS to which
# no AM_CFLAGS exit.

# While building lib<name>, set the variable NAME to <name> so we can access
# the package-specific variable <name>_HEADER, <name>_PACKAGE, etc. The
# following is a hack to prevent automake from assuming that we are overriding
# the libgtk2hs.a goal.
libgtk2hs_a_NAME = libgtk2hs.a
$(libgtk2hs_a_NAME) : NAME = libgtk2hs_a

libgtk2hs_a_TOPLEVEL 	= gtk/general/Gtk.hs
libgtk2hs_a_PACKAGECONF	= libgtk2hs_a.conf
libgtk2hs_a_PACKAGE	= gtk2hs
libgtk2hs_a_PACKAGEDEPS	= data
libgtk2hs_a_HEADER 	= gtk/gtk.h
libgtk2hs_a_PRECOMP	= gtk.precomp
libgtk2hs_a_CFLAGS 	= $(filter-out -I%,@GTK_CFLAGS@)
libgtk2hs_a_CPPFLAGS	= $(filter -I%,@GTK_CFLAGS@)
libgtk2hs_a_LIBS	= @GTK_LIBS@
libgtk2hs_a_HCFLAGS	= -fglasgow-exts

lib_LIBRARIES = libgtk2hs.a


libgtk2hs_a_SOURCES = \
	gtk/general/Hierarchy.chs \
	gtk/general/Signal.chs \
	gtk/glib/GValue.chs \
	gtk/glib/GList.chs \
	gtk/glib/GObject.chspp \
	gtk/pango/PangoTypes.chspp \
	gtk/treeList/TreeModel.chspp \
	gtk/treeList/TreeViewColumn.chs \
	gtk/multiline/TextIter.chspp \
	gtk/gdk/Region.chspp \
	gtk/abstract/Bin.chs \
	gtk/abstract/Box.chs \
	gtk/abstract/ButtonBox.chspp \
	gtk/abstract/Container.chs \
	gtk/abstract/FileChooser.chs \
	gtk/abstract/Misc.chs \
	gtk/abstract/Object.chspp \
	gtk/abstract/Paned.chs \
	gtk/abstract/Range.chs \
	gtk/abstract/Scale.chs \
	gtk/abstract/Widget.chs \
	gtk/buttons/Button.chspp \
	gtk/buttons/CheckButton.chs \
	gtk/buttons/RadioButton.chs \
	gtk/buttons/ToggleButton.chs \
	gtk/display/AccelLabel.chs \
	gtk/display/Image.chs \
	gtk/display/Label.chs \
	gtk/display/ProgressBar.chs \
	gtk/display/Statusbar.chs \
	gtk/entry/Editable.chs \
	gtk/entry/Entry.chspp \
	gtk/entry/EntryCompletion.chspp \
	gtk/entry/HScale.chs \
	gtk/entry/SpinButton.chs \
	gtk/entry/VScale.chs \
	gtk/general/Enums.chspp \
	gtk/general/General.chs \
	gtk/general/IconFactory.chspp \
	gtk/general/Style.chs \
	gtk/layout/Alignment.chspp \
	gtk/layout/AspectFrame.chs \
	gtk/layout/Expander.chspp \
	gtk/layout/Fixed.chs \
	gtk/layout/HBox.chs \
	gtk/layout/HButtonBox.chs \
	gtk/layout/HPaned.chs \
	gtk/layout/Layout.chs \
	gtk/layout/Notebook.chspp \
	gtk/layout/Table.chs \
	gtk/layout/VBox.chs \
	gtk/layout/VButtonBox.chs \
	gtk/layout/VPaned.chs \
	gtk/menuComboToolbar/CheckMenuItem.chspp \
	gtk/menuComboToolbar/Combo.chspp \
	gtk/menuComboToolbar/ComboBox.chspp \
	gtk/menuComboToolbar/ComboBoxEntry.chspp \
	gtk/menuComboToolbar/ImageMenuItem.chs \
	gtk/menuComboToolbar/Menu.chspp \
	gtk/menuComboToolbar/MenuBar.chs \
	gtk/menuComboToolbar/MenuItem.chs \
	gtk/menuComboToolbar/MenuShell.chs \
	gtk/menuComboToolbar/OptionMenu.chspp \
	gtk/menuComboToolbar/RadioMenuItem.chs \
	gtk/menuComboToolbar/TearoffMenuItem.chs \
	gtk/menuComboToolbar/ToolItem.chspp \
	gtk/menuComboToolbar/Toolbar.chspp \
	gtk/misc/Adjustment.chs \
	gtk/misc/Calendar.chspp \
	gtk/misc/DrawingArea.chs \
	gtk/misc/EventBox.chspp \
	gtk/misc/FileChooserWidget.chspp \
	gtk/misc/GArrow.chs \
	gtk/misc/HandleBox.chs \
	gtk/misc/SizeGroup.chs \
	gtk/misc/Tooltips.chspp \
	gtk/misc/Viewport.chs \
	gtk/multiline/TextBuffer.chs \
	gtk/multiline/TextMark.chs \
	gtk/multiline/TextTag.chspp \
	gtk/multiline/TextTagTable.chs \
	gtk/multiline/TextView.chs \
	gtk/ornaments/Frame.chs \
	gtk/ornaments/HSeparator.chs \
	gtk/ornaments/VSeparator.chs \
	gtk/scrolling/HScrollbar.chs \
	gtk/scrolling/ScrolledWindow.chs \
	gtk/scrolling/VScrollbar.chs \
	gtk/selectors/ColorSelection.chs \
	gtk/selectors/ColorSelectionDialog.chs \
	gtk/selectors/FontSelection.chs \
	gtk/selectors/FontSelectionDialog.chs \
	gtk/treeList/CellRendererPixbuf.chs \
	gtk/treeList/CellRendererText.chs \
	gtk/treeList/CellRendererToggle.chs \
	gtk/treeList/ListStore.chspp \
	gtk/treeList/TreeModelSort.chs \
	gtk/treeList/TreeSelection.chs \
	gtk/treeList/TreeStore.chspp \
	gtk/treeList/TreeView.chspp \
	gtk/windows/Dialog.chs \
	gtk/windows/FileChooserDialog.chspp \
	gtk/windows/FileSel.chs \
	gtk/windows/Window.chspp \
	gtk/gdk/Drawable.chspp \
	gtk/gdk/GC.chs \
	gtk/gdk/Gdk.chs \
	gtk/gdk/GdkEnums.chs \
	gtk/gdk/Keys.chs \
	gtk/gdk/Pixbuf.chs \
	gtk/glib/GError.chspp \
	gtk/glib/GType.chs \
	gtk/glib/GValueTypes.chs \
	gtk/pango/PangoLayout.chs \
	gtk/pango/Rendering.chs \
	gtk/embedding/Plug.chs \
	gtk/embedding/Socket.chs \
	gtk/general/StockItems.hsc \
	gtk/general/Structs.hsc \
	gtk/treeList/StoreValue.hsc \
	gtk/gdk/Events.hsc \
	gtk/glib/GParameter.hsc \
	gtk/embedding/Embedding.hsc \
	gtk/abstract/Scrollbar.hs \
	gtk/abstract/Separator.hs \
	gtk/general/FFI.hs \
	gtk/general/Gtk.hs \
	gtk/treeList/CellRenderer.hs \
	gtk/gdk/DrawWindow.hs \
	gtk/pango/Markup.hs \
	compat/LocalControl.hs \
	compat/LocalData.hs

libgtk2hs_a_CHSFILES = $(filter %.chs %.chspp, $(libgtk2hs_a_SOURCES))
libgtk2hs_a_CHSFILES_HS = $(patsubst %.chs,%.hs,\
	$(patsubst %.chspp,%.hs,$(libgtk2hs_a_CHSFILES)))
libgtk2hs_a_HSCFILES = $(filter %.hsc, $(libgtk2hs_a_SOURCES))
libgtk2hs_a_BUILDSOURCES = \
	$(libgtk2hs_a_CHSFILES_HS) \
	$(libgtk2hs_a_HSCFILES:.hsc=.hs)
libgtk2hs_a_HSFILES  = \
	$(libgtk2hs_a_BUILDSOURCES) \
	$(filter %.hs,$(libgtk2hs_a_SOURCES))




CONFIG_H = config.h

EMPTY =
SPACE = $(EMPTY) $(EMPTY)
VPATH = $(subst $(SPACE),:,$(strip \
	$(if $(subst .,,$(srcdir)),$(addprefix $(srcdir)/,$(SOURCEDIRS)), \
	$(SOURCEDIRS))))

BUILDSOURCES = $(libgtk2hs_a_BUILDSOURCES)

.hs.o: $(CONFIG_H)
	if test -f .depend; then \
	$(strip $(HC) -c $< -o $@ $($(NAME)_HCFLAGS) -i$(VPATH) \
	  $(addprefix -package ,$($(NAME)_PACKAGEDEPS)) \
	  $(addprefix -package-name ,$($(NAME)_PACKAGE)) \
	  $(addprefix '-\#include<,$(addsuffix >',$(CONFIG_H) \
	  $($(NAME)_EXTRA_HFILES))) \
	  $(AM_CPPFLAGS) $($(NAME)_EXTRA_CPPFLAGS) $($(NAME)_CPPFLAGS))\
	; else \
	  $(MAKE) $(AM_MAKEFLAGS) NAME="$(NAME)" $($(NAME)_BUILDSOURCES) \
	  && \
	  $(strip $(HC) -M $(addprefix -optdep,-f .depend) \
	  $($(NAME)_HCFLAGS) -i$(VPATH) \
	  $(addprefix -package ,$($(NAME)_PACKAGEDEPS)) \
	  $(addprefix '-\#include<,$(addsuffix >',$(CONFIG_H) \
	  $($(NAME)_EXTRA_HFILES))) \
	  $(AM_CPPFLAGS) $($(NAME)_EXTRA_CPPFLAGS) $($(NAME)_CPPFLAGS) \
	  $($(NAME)_HSFILES)) \
	; fi

.o.hi:
	@:

HSTOOLFLAGS = -H500m

.PHONY: debug
debug	:
	@echo VPATH: $(VPATH)

%.precomp :
	$(strip $(C2HS) $(C2HS_FLAGS) +RTS $(HSTOOLFLAGS) -RTS \
	$(addprefix -C,$($(NAME)_CFLAGS) $($(NAME)_CPPFLAGS)) \
	--precomp=$($(NAME)_PRECOMP) $($(NAME)_HEADER))

.chspp.chs: $(CONFIG_H)
	$(strip $(HSCPP) $(AM_CPPFLAGS) \
	$($(NAME)_EXTRA_CPPFLAGS) $($(NAME)_CPPFLAGS) \
	$($(NAME)_EXTRA_CFLAGS) $($(NAME)_CFLAGS) \
	$(addprefix -include ,$(CONFIG_H) $($(NAME)_EXTRA_HFILES)) \
	$< -o $@)

.hsc.hs:
	$(strip $(HSC) $(HSCFLAGS) +RTS $(HSTOOLFLAGS) -RTS \
        $(addprefix -L-optl,\
	$(AM_LDFLAGS) $($(NAME)_EXTRA_LIBS) $($(NAME)_LIBS)) \
        $(addprefix -C,	$(filter-out -I%,$(AM_CPPFLAGS)) \
	$($(NAME)_EXTRA_CFLAGS) $($(NAME)_CFLAGS))\
        $(filter -I%,$(AM_CPPFLAGS)) \
	$($(NAME)_EXTRA_CPPFLAGS) $($(NAME)_CPPFLAGS)\
        --cc=$(HC) --lflag=-no-hs-main $<)

.chs.hs:
	if test -f $($(NAME)_PRECOMP); then :; else \
	  $(MAKE) $(AM_MAKEFLAGS) NAME="$(NAME)" $($(NAME)_PRECOMP); fi;
	$(strip $(C2HS) $(C2HS_FLAGS) +RTS $(HSTOOLFLAGS) -RTS \
	-i$(VPATH) --precomp=$($(NAME)_PRECOMP) -o $@ $<)
	$(CHSDEPEND) -i$(VPATH) $<

-include .depend *.dep


#	$(ECHO) no header file associated with $@
#	exit 1
#
#$(libgtk2hs_a_CHSFILES:.chs=.hs) : %.hs : %.chs $(libgtk2hs_a_PRECOMP)


--- configure.in DELETED ---

Index: aclocal.m4
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/aclocal.m4,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- aclocal.m4	16 Aug 2004 07:35:54 -0000	1.4
+++ aclocal.m4	24 Oct 2004 17:19:18 -0000	1.5
@@ -1,6 +1,6 @@
-# generated automatically by aclocal 1.7.5 -*- Autoconf -*-
+# generated automatically by aclocal 1.8.3 -*- Autoconf -*-
 
-# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
 # Free Software Foundation, Inc.
 # This file is free software; the Free Software Foundation
 # gives unlimited permission to copy and/or distribute it,
@@ -11,99 +11,6 @@
 # even the implied warranty of MERCHANTABILITY or FITNESS FOR A
 # PARTICULAR PURPOSE.
[...972 lines suppressed...]
+# specify the program used to strip binaries.  This is especially
+# annoying in cross-compiling environments, where the build's strip
+# is unlikely to handle the host's binaries.
+# Fortunately install-sh will honor a STRIPPROG variable, so we
+# always use install-sh in `make install-strip', and initialize
+# STRIPPROG with the value of the STRIP variable (set by the user).
+AC_DEFUN([AM_PROG_INSTALL_STRIP],
+[AC_REQUIRE([AM_PROG_INSTALL_SH])dnl
+# Installed binaries are usually stripped using `strip' when the user
+# run `make install-strip'.  However `strip' might not be the right
+# tool to use in cross-compilation environments, therefore Automake
+# will honor the `STRIP' environment variable to overrule this program.
+dnl Don't test for $cross_compiling = yes, because it might be `maybe'.
+if test "$cross_compiling" != no; then
+  AC_CHECK_TOOL([STRIP], [strip], :)
+fi
+INSTALL_STRIP_PROGRAM="\${SHELL} \$(install_sh) -c -s"
+AC_SUBST([INSTALL_STRIP_PROGRAM])])
+
+m4_include([acinclude.m4])

Index: TODO
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/TODO,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- TODO	21 Jan 2003 15:53:07 -0000	1.5
+++ TODO	24 Oct 2004 17:19:18 -0000	1.6
@@ -1,4 +1,7 @@
 TODO for gtk2hs
+24/10/2004 Axel Simon <A....@ke...>
+	* Hierarchy.chs: c2hs 0.13.1 produces a with<Object> functions for
+	every newtype definition. Import withForeignPtr for this.
 
 21/01/2003 Axel Simon <A....@uk...>
 

Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.228
retrieving revision 1.229
diff -u -d -r1.228 -r1.229
--- ChangeLog	4 Sep 2004 09:09:08 -0000	1.228
+++ ChangeLog	24 Oct 2004 17:19:18 -0000	1.229
@@ -1,3 +1,14 @@
+2004-10-24  Axel Simon <A....@ke...>
+
+	* configure.in, configure.ac, Makefile, Makefile.am: Removed old
+	and added new versions these. The new build system is based on
+	automake. 38 files in gtk/* were pre-processed with cpp. These
+	have all been renamed to .chspp.
+	
+	* tools/hierachyGen/TypeGen.hs: Add newline to help message. Let
+	generated file import withForeignPtr which is used by the c2hs
+	generated code.
+
 2004-09-04  Axel Simon <A....@ke...>
 
 	* Makefile, mk/recurse.mk: Set MAKE_APPS to empty and introduce

--- Makefile DELETED ---

[Gtk2hs-commit] gtk2hs/mk common.mk,1.32,1.33

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/mk
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28086/mk

Modified Files:
	common.mk 
Log Message:
New build system.


Index: common.mk
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/mk/common.mk,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -d -r1.32 -r1.33
--- common.mk	19 Aug 2004 07:54:20 -0000	1.32
+++ common.mk	24 Oct 2004 17:19:26 -0000	1.33
@@ -327,16 +327,16 @@
 .PHONY: clean distclean mostlyclean maintainer-clean
 
 mostlyclean : noinplace
-	$(strip $(RM) $(TARGETOK) $(ALLHSFILES:.hs=.o) $(ALLHSFILES:.hs=.hi) \
+	-$(strip $(RM) -rf $(TARGETOK) $(ALLHSFILES:.hs=.o) $(ALLHSFILES:.hs=.hi) \
 	  $(EXTRA_CFILES:.c=.o) $(ALLHSFILES:.hs=_stub.*) .depend \
 	  $(ALLCHSFILES:.chs=.dep))
 
 clean	: mostlyclean
-	$(strip $(RM) $(ALLCHSFILES:.chs=.hs) $(ALLCHSFILES:.chs=.chi) \
+	-$(strip $(RM) -rf $(ALLCHSFILES:.chs=.hs) $(ALLCHSFILES:.chs=.chi) \
 	  $(HSCFILES:.hsc=.hs) $(EXTRA_CLEANFILES))
 
 distclean : clean
-	$(strip $(RM) $(EXTRA_HSFILES) $(EXTRA_CHSFILES) \
+	-$(strip $(RM) -rf $(EXTRA_HSFILES) $(EXTRA_CHSFILES) \
 	  $(ALLCHSFILES:.chs=.dep) $(LOCALPKGCONF) $(LOCALPKGCONF).old \
 	  $(EXTRA_DISTCLEANFILES))
 

[Gtk2hs-commit] gtk2hs/gtk/windows FileChooserDialog.chspp,NONE,1.1 Window.chspp,NONE,1.1 FileChooserDialog.chs,1.4,NONE Window.chs,1.8,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/windows
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28086/gtk/windows

Added Files:
	FileChooserDialog.chspp Window.chspp 
Removed Files:
	FileChooserDialog.chs Window.chs 
Log Message:
New build system.


--- NEW FILE: FileChooserDialog.chspp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) entry Widget FileChooserDialog
--
--  Author : Duncan Coutts
--  Created: 24 April 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- The file chooser dialog and widget is a replacement
-- for the old "FileSel"ection dialog. It provides a better user
-- interface and an improved API.
--
-- * This is the dialog variant of the "FileChooser"
--
-- * Added in GTK+ 2.4
--
module FileChooserDialog (
#if GTK_CHECK_VERSION(2,4,0)
  FileChooserDialogClass,
  FileChooserDialog,
  fileChooserDialogNew,
  fileChooserDialogNewWithBackend
#endif
) where

#if GTK_CHECK_VERSION(2,4,0)

import Monad (liftM, when)
import Maybe (isJust, fromJust)
import FFI
{#import Hierarchy#}
{#import FileChooser#}
import GObject (objectNew)
import Object (makeNewObject)
import Window
import Dialog
import GValue
import StoreValue

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

-- The FileChooserDialog implements the FileChooser interface
-- which we model in Haskell as another instance decleration
instance FileChooserClass FileChooserDialog

fileChooserDialogNew
  :: Maybe String            -- ^ Title of the dialog (or default)
  -> Maybe Window            -- ^ Transient parent of the dialog (or none)
  -> FileChooserAction       -- ^ Open or save mode for the dialog
  -> [(String, ResponseId)]  -- ^ Buttons and their response codes
  -> IO FileChooserDialog
fileChooserDialogNew title parent action buttons =
  internalFileChooserDialogNew title parent action buttons Nothing


fileChooserDialogNewWithBackend
  :: Maybe String              -- ^ Title of the dialog (or default)
  -> Maybe Window              -- ^ Transient parent of the dialog (or none)
  -> FileChooserAction         -- ^ Open or save mode for the dialog
  -> [(String, ResponseId)]    -- ^ Buttons and their response codes
  -> String                    -- ^ The name of the filesystem backend to use
  -> IO FileChooserDialog
fileChooserDialogNewWithBackend title parent action buttons backend =
  internalFileChooserDialogNew title parent action buttons (Just backend)
  

-- Annoyingly, the constructor for FileChooserDialog uses varargs so we can't
-- call it using the Haskell FFI. The GTK people do not consider this an api
-- bug, see <http://bugzilla.gnome.org/show_bug.cgi?id=141004>
-- The solution is to call objectNew and add the buttons manually.

internalFileChooserDialogNew ::
  Maybe String ->           -- Title of the dialog (or default)
  Maybe Window ->           -- Transient parent of the dialog (or none)
  FileChooserAction ->      -- Open or save mode for the dialog
  [(String, ResponseId)] -> -- Buttons and their response codes
  Maybe String ->           -- The name of the backend to use (optional)
  IO FileChooserDialog
internalFileChooserDialogNew title parent action buttons backend = do
  objType <- {# call unsafe gtk_file_chooser_dialog_get_type #}
  dialog <-makeNewObject mkFileChooserDialog $ liftM castPtr $
           if (isJust backend)
             then with (GVstring backend) $ \backendGValue ->
                  objectNew objType [("file-system-backend", backendGValue)]
             else objectNew objType []
  when (isJust title)
       (dialog `windowSetTitle` fromJust title)
  when (isJust parent)
       (dialog `windowSetTransientFor` fromJust parent)
  dialog `fileChooserSetAction` action
  mapM_ (\(btnName, btnResponse) ->
          dialogAddButton dialog btnName btnResponse) buttons
  return dialog

#endif

--- NEW FILE: Window.chspp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Window
--
--  Author : Manuel M. T. Chakravarty, Axel Simon
--          
--  Created: 27 April 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/24 17:19:25 $
--
--  Copyright (c) 2001 Manuel M. T. Chakravarty, 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.
--
-- |
--
-- TODO
--
-- * missing but possibly useful methods are commented out
--      
module Window(
  Window,
  WindowClass,
  castToWindow,
  windowNew,
  windowSetTitle,
  windowSetResizable,
  windowGetResizable,
--  windowAddAccelGroup, 
--  windowRemoveAccelGroup,
  windowActivateFocus,
  windowActivateDefault,
  windowSetModal,
  windowSetDefaultSize,
--  windowSetGeometryHints,
#ifndef DISABLE_DEPRECATED
  windowSetPolicy,
#endif
  windowSetPosition,
  WindowPosition(..),
  windowSetTransientFor,
  windowSetDestroyWithParent,
-- windowListToplevels,
-- windowAddMnemonic,
-- windowRemoveMnemonic,
-- windowSetMnemonicModifier,
  windowDeiconify,
  windowIconify,
  windowMaximize,
  windowUnmaximize,
  windowSetDecorated,
-- windowSetDecorationsHint,
  windowSetFrameDimensions,
-- windowSetFunctionHint,
  windowSetRole,
  windowStick,
  windowUnstick,
  onFrameEvent,
  afterFrameEvent,
  onSetFocus,
  afterSetFocus
  ) where

import Monad	(liftM)
import FFI

import Enums	(WindowType(WindowToplevel), WindowPosition(..))
import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}
import Events	(Event, marshalEvent)

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

-- methods

-- | Create a new window of the given type.
--
windowNew :: IO Window
windowNew = makeNewObject mkWindow $ liftM castPtr $
  {#call window_new#} ((fromIntegral.fromEnum) WindowToplevel)

-- | set the title string of the given window
--
windowSetTitle :: WindowClass w => w -> String -> IO ()
windowSetTitle w str = 
  withUTFString str ({#call window_set_title#} (toWindow w))

-- | Sets whether the user can resize a window.
--
-- * Windows are user resizable by default.
--
windowSetResizable :: WindowClass w => w -> Bool -> IO ()
windowSetResizable w res = 
  {#call window_set_resizable#} (toWindow w) (fromBool res)

-- | Retrieve the value set by
-- 'windowSetResizable'.
--
windowGetResizable :: WindowClass w => w -> IO Bool
windowGetResizable w = liftM toBool $ 
  {#call unsafe window_get_resizable#} (toWindow w)

-- | dunno
--
windowActivateFocus :: WindowClass w => w -> IO Bool
windowActivateFocus w = 
  liftM toBool $ {#call window_activate_focus#} (toWindow w)

-- | dunno
--
windowActivateDefault :: WindowClass w => w -> IO Bool
windowActivateDefault w = 
  liftM toBool $ {#call window_activate_default#} (toWindow w)

#ifndef DISABLE_DEPRECATED
{-# DEPRECATED windowSetPolicy "Use windowSetResizable instead." #-}
-- windowSetPolicy: set the window policy
--
windowSetPolicy :: WindowClass w => w -> Bool -> Bool -> Bool -> IO ()
windowSetPolicy w shrink grow auto = {#call window_set_policy#} 
  (toWindow w) (fromBool shrink) (fromBool grow) (fromBool auto)
#endif

-- | make a window application modal
--
windowSetModal :: WindowClass w => w -> Bool -> IO ()
windowSetModal w m = {#call window_set_modal#} (toWindow w) (fromBool m)

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

-- | set the window position policy
--
windowSetPosition :: WindowClass w => w -> WindowPosition -> IO ()
windowSetPosition w pos = 
  {#call window_set_position#} (toWindow w) ((fromIntegral.fromEnum) pos)

-- | set transient window
--
windowSetTransientFor :: (WindowClass win, WindowClass parent) => win ->
                         parent -> IO ()
windowSetTransientFor w p = 
  {#call window_set_transient_for#} (toWindow w) (toWindow p)

-- | destory transient window with parent
--
windowSetDestroyWithParent :: WindowClass w => w -> Bool -> IO ()
windowSetDestroyWithParent w b = 
  {#call window_set_destroy_with_parent#} (toWindow w) (fromBool b)

-- | restore the window
--
windowDeiconify :: WindowClass w => w -> IO ()
windowDeiconify w = {#call window_deiconify#} (toWindow w)

-- | minimize the window
--
windowIconify :: WindowClass w => w -> IO ()
windowIconify w = {#call window_iconify#} (toWindow w)

-- | maximize the window
--
windowMaximize :: WindowClass w => w -> IO ()
windowMaximize w = {#call window_maximize#} (toWindow w)

-- | unmaximize the window
--
windowUnmaximize :: WindowClass w => w -> IO ()
windowUnmaximize w = {#call window_unmaximize#} (toWindow w)

-- | remove the border
--
windowSetDecorated :: WindowClass w => w -> Bool -> IO ()
windowSetDecorated w b =
  {#call window_set_decorated#} (toWindow w) (fromBool b)

-- | set border widths
--
windowSetFrameDimensions :: WindowClass w => w -> Int -> Int -> Int -> Int ->
                            IO ()
windowSetFrameDimensions w left top right bottom =
 {#call window_set_frame_dimensions#} (toWindow w) (fromIntegral left)
 (fromIntegral top) (fromIntegral right) (fromIntegral bottom)

-- | set role (additional window name for the WM)
--
windowSetRole :: WindowClass w => w -> String -> IO ()
windowSetRole w str = 
  withUTFString str ({#call window_set_role#} (toWindow w))

-- | show the window on every workspace
--
windowStick :: WindowClass w => w -> IO ()
windowStick w = {#call window_stick#} (toWindow w)

-- | do not show the window on every workspace
--
windowUnstick :: WindowClass w => w -> IO ()
windowUnstick w = {#call window_unstick#} (toWindow w)

-- signals

-- | 
--
onFrameEvent, afterFrameEvent :: WindowClass w => w -> (Event -> IO Bool) ->
                                 IO (ConnectId w)
onFrameEvent = connect_BOXED__BOOL "frame_event" marshalEvent False
afterFrameEvent = connect_BOXED__BOOL "frame_event" marshalEvent True

-- | 
--
onSetFocus, afterSetFocus :: (WindowClass w, WidgetClass foc) => w ->
                             (foc -> IO ()) -> IO (ConnectId w)
onSetFocus = connect_OBJECT__NONE "set_focus" False
afterSetFocus = connect_OBJECT__NONE "set_focus" True




--- Window.chs DELETED ---

--- FileChooserDialog.chs DELETED ---

[Gtk2hs-commit] gtk2hs/tools/hierarchyGen TypeGen.hs,1.8,1.9

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/tools/hierarchyGen
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28086/tools/hierarchyGen

Modified Files:
	TypeGen.hs 
Log Message:
New build system.


Index: TypeGen.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/hierarchyGen/TypeGen.hs,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- TypeGen.hs	26 Jul 2004 12:14:47 -0000	1.8
+++ TypeGen.hs	24 Oct 2004 17:19:26 -0000	1.9
@@ -134,7 +134,7 @@
 	\  <prefix>        set the prefix to use in the c2hs {#context #}\n\
 	\                  declaration (the default is \"gtk\")\n\
 	\  <modName>       specify module name if it does not match the\n\
-	\                  file name, eg a hierarchical module name"
+	\                  file name, eg a hierarchical module name\n"
  exitWith $ ExitFailure 1
 
 
@@ -154,7 +154,7 @@
   indent 0.ss "--".
   indent 0.ss "--  Author : Axel Simon".
   indent 0.ss "--".
-  indent 0.ss "--  Copyright (c) 2001-2003 Axel Simon".
+  indent 0.ss "--  Copyright (c) 2001-2004 Axel Simon".
   indent 0.ss "--".
   indent 0.ss "--  This file is free software; you can redistribute it and/or modify".
   indent 0.ss "--  it under the terms of the GNU General Public License as published by".
@@ -180,7 +180,8 @@
 		indent 1.ss "castTo".ss n) objs).
   indent 1.ss ") where".
   indent 0.
-  indent 0.ss "import FFI	(ForeignPtr, castForeignPtr, foreignPtrToPtr,".  ss " CULong)".
+  indent 0.ss "import FFI	(ForeignPtr, castForeignPtr, foreignPtrToPtr,".
+  indent 8.ss " CULong, withForeignPtr)".
   indent 0.ss "import GType    (typeInstanceIsA)".
   indent 0.ss "import GHC.Base (unsafeCoerce#)".
   -- this is a very bad hack to get the definition of the ancestors whenever

[Gtk2hs-commit] gtk2hs/gtk/misc Calendar.chspp,NONE,1.1 EventBox.chspp,NONE,1.1 FileChooserWidget.chspp,NONE,1.1 Tooltips.chspp,NONE,1.1 Calendar.chs,1.5,NONE EventBox.chs,1.6,NONE FileChooserWidget.chs,1.3,NONE Tooltips.chs,1.8,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/misc
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28086/gtk/misc

Added Files:
	Calendar.chspp EventBox.chspp FileChooserWidget.chspp 
	Tooltips.chspp 
Removed Files:
	Calendar.chs EventBox.chs FileChooserWidget.chs Tooltips.chs 
Log Message:
New build system.


--- NEW FILE: EventBox.chspp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget EventBox
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/24 17:19:23 $
--
--  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.
--
-- |
--
-- This container can be used to receive 'Event's for a widget
-- that has no window on its own.
--
-- TODO
--
-- * check: Is this widget useful?
--
module EventBox(
  EventBox,
  EventBoxClass,
  castToEventBox,
  eventBoxNew
#if GTK_CHECK_VERSION(2,4,0)
 ,eventBoxSetVisibleWindow,
  eventBoxGetVisibleWindow,
  eventBoxSetAboveChild,
  eventBoxGetAboveChild
#endif
  ) where

import Monad	(liftM)
import FFI

import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}

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

-- methods

-- | Create a new 'EventBox'.
--
eventBoxNew :: IO EventBox
eventBoxNew  = makeNewObject mkEventBox $ 
  liftM castPtr {#call unsafe event_box_new#}

#if GTK_CHECK_VERSION(2,4,0)
-- | Set whether the event box uses a visible or invisible child window. The
-- default is to use visible windows. The C documentation for details of what
-- difference this makes.
--
eventBoxSetVisibleWindow :: EventBox -> Bool -> IO ()
eventBoxSetVisibleWindow ebox visible =
  {#call event_box_set_visible_window#} ebox (fromBool visible)

-- | Returns whether the event box has a visible window.
--
eventBoxGetVisibleWindow :: EventBox -> IO Bool
eventBoxGetVisibleWindow ebox =
  liftM toBool $ {#call unsafe event_box_get_visible_window#} ebox

-- | Set whether the event box window is positioned above the windows of its
-- child, as opposed to below it. 
--
-- * If the window is above, all events inside the event box will go to the
-- event box. If the window is below, events in windows of child widgets will
-- first got to that widget, and then to its parents.
--
eventBoxSetAboveChild :: EventBox -> Bool -> IO ()
eventBoxSetAboveChild ebox above =
  {#call event_box_set_above_child#} ebox (fromBool above)

-- | Returns whether the event box window is above or below the windows of its
-- child. See 'eventBoxSetAboveChild' for details.
--
eventBoxGetAboveChild :: EventBox -> IO Bool
eventBoxGetAboveChild ebox =
  liftM toBool $ {#call unsafe event_box_get_above_child#} ebox
#endif

--- NEW FILE: FileChooserWidget.chspp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) entry Widget FileChooserWidget
--
--  Author : Duncan Coutts
--  Created: 24 April 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
--  The file chooser dialog and widget is a replacement
--  for the old "FileSel"ection dialog. It provides a better user
--  interface and an improved API.
--
-- * This is the widget variant of the "FileChooser"
--
-- * Added in GTK+ 2.4
--
module FileChooserWidget (
#if GTK_CHECK_VERSION(2,4,0)
  FileChooserWidgetClass,
  FileChooserWidget,
  FileChooserAction,
  fileChooserWidgetNew,
  fileChooserWidgetNewWithBackend,
#endif
) where

#if GTK_CHECK_VERSION(2,4,0)

import Monad (liftM)
import FFI
import Object
{#import Hierarchy#}
{#import FileChooser#} (FileChooserAction)

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

-- The FileChooserWidget implements the FileChooser interface
-- which we model in Haskell as another instance decleration
instance FileChooserClass FileChooserWidget

fileChooserWidgetNew ::  FileChooserAction -> IO FileChooserWidget
fileChooserWidgetNew action =
  makeNewObject mkFileChooserWidget $ liftM castPtr $
  {# call unsafe gtk_file_chooser_widget_new #}
    (fromIntegral $ fromEnum action)

fileChooserWidgetNewWithBackend ::  FileChooserAction -> String -> IO FileChooserWidget
fileChooserWidgetNewWithBackend action backend =
  makeNewObject mkFileChooserWidget $ liftM castPtr $
  withCString backend $ \strPtr ->
  {# call unsafe gtk_file_chooser_widget_new_with_backend #}
    (fromIntegral $ fromEnum action) strPtr

#endif

--- Tooltips.chs DELETED ---

--- NEW FILE: Calendar.chspp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Calendar
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/24 17:19:23 $
--
--  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.
--
-- |
--
-- This widget shows a calendar.
--
module Calendar(
  Calendar,
  CalendarClass,
  castToCalendar,
  calendarNew,
  calendarSelectMonth,
  calendarSelectDay,
  calendarMarkDay,
  calendarUnmarkDay,
  calendarClearMarks,
  calendarDisplayOptions,
#if GTK_CHECK_VERSION(2,4,0)
  calendarSetDisplayOptions,
  calendarGetDisplayOptions,
#endif
  calendarGetDate,
  onDaySelected,
  afterDaySelected,
  onDaySelectedDoubleClick,
  afterDaySelectedDoubleClick,
  onMonthChanged,
  afterMonthChanged,
  onNextMonth,
  afterNextMonth,
  onNextYear,
  afterNextYear,
  onPrevMonth,
  afterPrevMonth,
  onPrevYear,
  afterPrevYear
  ) where

import Monad	(liftM)
import FFI

import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}
import Enums	(CalendarDisplayOptions(..), fromFlags, toFlags)

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

-- methods

-- | Create a new calendar widget.
--
-- * No sensible date will be set.
--
calendarNew :: IO Calendar
calendarNew  = makeNewObject mkCalendar $ 
  liftM castPtr {#call unsafe calendar_new#}

-- | Flip the page to a month , 0 is January,.., 11
-- is December.
--
-- * Returns True if the operation succeeded.
--
calendarSelectMonth :: CalendarClass c => c -> Int -> Int -> IO Bool
calendarSelectMonth cal month year = liftM toBool $
  {#call calendar_select_month#} (toCalendar cal) (fromIntegral month)
  (fromIntegral year)

-- | Shift to a day, counted form 1 to 31 (depending
-- on the month of course).
--
calendarSelectDay :: CalendarClass c => c -> Int -> IO ()
calendarSelectDay cal day = 
  {#call calendar_select_day#} (toCalendar cal) (fromIntegral day)

-- | Mark (select) a day in the current month.
--
-- * Returns True if the argument was within bounds and the day was previously
--   deselected.
--
calendarMarkDay :: CalendarClass c => c -> Int -> IO Bool
calendarMarkDay cal day = liftM toBool $
  {#call calendar_mark_day#} (toCalendar cal) (fromIntegral day)

-- | Unmark (deselect) a day in the current month.
--
-- * Returns True if the argument was within bounds and the day was previously
--   selected.
--
calendarUnmarkDay :: CalendarClass c => c -> Int -> IO Bool
calendarUnmarkDay cal day = liftM toBool $
  {#call calendar_unmark_day#} (toCalendar cal) (fromIntegral day)

-- | Unmark every day in the current page.
--
calendarClearMarks :: CalendarClass c => c -> IO ()
calendarClearMarks cal = {#call calendar_clear_marks#} (toCalendar cal)

#if GTK_CHECK_VERSION(2,4,0)
-- | Specifies how the calendar should be displayed.
--
calendarSetDisplayOptions :: CalendarClass c => c
                          -> [CalendarDisplayOptions] -> IO ()
calendarSetDisplayOptions cal opts =
  {#call calendar_set_display_options#} (toCalendar cal)
    ((fromIntegral.fromFlags) opts)

-- | Returns the current display options for the calendar.
--
calendarGetDisplayOptions :: CalendarClass c => c
                          -> IO [CalendarDisplayOptions]
calendarGetDisplayOptions cal = liftM (toFlags.fromIntegral) $
  {#call calendar_get_display_options#} (toCalendar cal)

-- | Depreciaded, use 'calendarSetDisplayOptions'.
--
calendarDisplayOptions :: CalendarClass c => c
                       -> [CalendarDisplayOptions] -> IO ()
calendarDisplayOptions = calendarSetDisplayOptions
#else

-- | Specifies how the calendar should be displayed.
--
calendarDisplayOptions :: CalendarClass c => c -> [CalendarDisplayOptions] ->
                          IO ()
calendarDisplayOptions cal opts = {#call calendar_display_options#}
  (toCalendar cal) ((fromIntegral.fromFlags) opts)
#endif

-- | Retrieve the currently selected date.
--
-- * Returns (year, month, day) of the selection.
--
calendarGetDate :: CalendarClass c => c -> IO (Int,Int,Int)
calendarGetDate cal = alloca $ \yearPtr -> alloca $ \monthPtr -> 
  alloca $ \dayPtr -> do
    {#call unsafe calendar_get_date#} (toCalendar cal) yearPtr monthPtr dayPtr
    year  <- liftM fromIntegral $ peek yearPtr
    month <- liftM fromIntegral $ peek monthPtr
    day	  <- liftM fromIntegral	$ peek dayPtr
    return (year,month,day)

-- | Freeze the calender for several update operations.
--
calendarFreeze :: CalendarClass c => c -> IO a -> IO a
calendarFreeze cal update = do
  {#call unsafe calendar_freeze#} (toCalendar cal)
  res <- update
  {#call calendar_thaw#} (toCalendar cal)
  return res

-- signals

-- | Emitted when a day was selected.
--
onDaySelected, afterDaySelected :: CalendarClass c => c -> IO () ->
                                   IO (ConnectId c)
onDaySelected = connect_NONE__NONE "day-selected" False
afterDaySelected = connect_NONE__NONE "day-selected" True

-- | Emitted when a day received a
-- double click.
--
onDaySelectedDoubleClick, afterDaySelectedDoubleClick :: CalendarClass c => 
                                                         c -> IO () ->
                                                         IO (ConnectId c)
onDaySelectedDoubleClick = 
  connect_NONE__NONE "day-selected-double-click" False
afterDaySelectedDoubleClick = 
  connect_NONE__NONE "day-selected-double-click" True

-- | The month changed.
--
onMonthChanged, afterMonthChanged :: CalendarClass c => c -> IO () ->
                                     IO (ConnectId c)
onMonthChanged = connect_NONE__NONE "month-changed" False
afterMonthChanged = connect_NONE__NONE "month-changed" True

-- | The next month was selected.
--
onNextMonth, afterNextMonth :: CalendarClass c => c -> IO () ->
                               IO (ConnectId c)
onNextMonth = connect_NONE__NONE "next-month" False
afterNextMonth = connect_NONE__NONE "next-month" True

-- | The next year was selected.
--
onNextYear, afterNextYear :: CalendarClass c => c -> IO () -> IO (ConnectId c)
onNextYear = connect_NONE__NONE "next-year" False
afterNextYear = connect_NONE__NONE "next-year" True

-- | The previous month was selected.
--
onPrevMonth, afterPrevMonth :: CalendarClass c => c -> IO () ->
                               IO (ConnectId c)
onPrevMonth = connect_NONE__NONE "prev-month" False
afterPrevMonth = connect_NONE__NONE "prev-month" True

-- | The previous year was selected.
--
onPrevYear, afterPrevYear :: CalendarClass c => c -> IO () -> IO (ConnectId c)
onPrevYear = connect_NONE__NONE "prev-year" False
afterPrevYear = connect_NONE__NONE "prev-year" True

  

--- EventBox.chs DELETED ---

--- Calendar.chs DELETED ---

--- NEW FILE: Tooltips.chspp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Tooltips
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/24 17:19:23 $
--
--  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.
--
-- |
--
-- Tooltips are the messages that appear next to a widget when the mouse
-- pointer is held over it for a short amount of time. They are especially
-- helpful for adding more verbose descriptions of things such as buttons
-- in a toolbar. 
--
-- An individual tooltip belongs to a group of tooltips. A group is created
-- with a call to 'tooltipsNew'. Every tooltip in the group can 
-- then be turned off with a call to 'tooltipsDisable' and enabled with 
-- 'tooltipsEnable'.
--
#ifndef DISABLE_DEPRECATED
-- The length of time the user must keep the mouse over a widget before the tip
-- is shown, can be altered with 'tooltipsSetDelay'. This is set on a 'per group
-- of tooltips' basis.
--
#endif
-- To assign a tip to a particular widget, 'tooltipsSetTip' is used.
--
-- To associate 'Tooltips' to a widget it is has to have its own 'DrawWindow'.
-- Otherwise the widget must be set into an 'EventBox'.
--
module Tooltips(
  Tooltips,
  TooltipsClass,
  castToTooltips,
  tooltipsNew,
  tooltipsEnable,
  tooltipsDisable,
#ifndef DISABLE_DEPRECATED
  tooltipsSetDelay,
#endif
  tooltipsSetTip,
  tooltipsDataGet
  ) where

import Monad	(liftM)
import FFI

import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}

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

-- methods

-- | Create a new goup of 'Tooltips'.
--
tooltipsNew :: IO Tooltips
tooltipsNew  = makeNewObject mkTooltips $ 
  liftM castPtr {#call unsafe tooltips_new#}

-- | Display the help the 'Tooltips' group
-- provides.
--
tooltipsEnable :: TooltipsClass t => t -> IO ()
tooltipsEnable t = {#call unsafe tooltips_enable#} (toTooltips t)

-- | Disable 'Tooltips' group.
--
-- * Causes all tooltips in tooltips to become inactive. Any widgets that have
--   tips associated with that group will no longer display their tips until
--   they are enabled again with 'tooltipsEnable'.
--
tooltipsDisable :: TooltipsClass t => t -> IO ()
tooltipsDisable t = {#call unsafe tooltips_disable#} (toTooltips t)

#ifndef DISABLE_DEPRECATED
-- | Sets the time between the user moving the mouse
-- over a widget and the widget's tooltip appearing.
--
-- * The @time@ parameter is in ms.
--
tooltipsSetDelay :: TooltipsClass t => t -> Int -> IO ()
tooltipsSetDelay t time = {#call unsafe tooltips_set_delay#}
  (toTooltips t) (fromIntegral time)
#endif

-- | Adds a tooltip containing the message tipText to
-- the specified GtkWidget.
--
-- * The @tipPrivate@ parameter is meant to give a thorough
--   explaination. This might someday be accessible to a questionmark cursor
--   (like MS Windows).
--
tooltipsSetTip :: (TooltipsClass t, WidgetClass w) => t -> w -> String ->
                  String -> IO ()
tooltipsSetTip t w tipText tipPrivate = 
  withUTFString tipPrivate $ \priPtr ->
  withUTFString tipText $ \txtPtr ->
  {#call unsafe tooltips_set_tip#} (toTooltips t) (toWidget w) txtPtr priPtr

{#pointer * TooltipsData#}

-- | Retrieves any 'Tooltips' previously associated with the given widget.
--
tooltipsDataGet :: WidgetClass w => w -> IO (Maybe (Tooltips, String, String))
tooltipsDataGet w = do
  tipDataPtr <- {#call unsafe tooltips_data_get#} (toWidget w)
  if tipDataPtr == nullPtr
    then return Nothing
    else do --next line is a hack, tooltips struct member is at offset 0
	   tooltips <- makeNewObject mkTooltips (return $ castPtr tipDataPtr)
           tipText  <- {#get TooltipsData->tip_text#} tipDataPtr
                   >>= peekUTFString
           tipPrivate <- {#get TooltipsData->tip_private#} tipDataPtr
                     >>= peekUTFString
           return $ Just $ (tooltips, tipText, tipPrivate)


--- FileChooserWidget.chs DELETED ---

[Gtk2hs-commit] gtk2hs/gtk/multiline TextIter.chspp,NONE,1.1 TextTag.chspp,NONE,1.1 TextIter.chs,1.13,NONE TextTag.chs,1.7,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/multiline
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28086/gtk/multiline

Added Files:
	TextIter.chspp TextTag.chspp 
Removed Files:
	TextIter.chs TextTag.chs 
Log Message:
New build system.


--- TextTag.chs DELETED ---

--- NEW FILE: TextTag.chspp ---
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget TextTag
--
--  Author : Duncan Coutts
--  Created: 4 August 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- A tag that can be applied to text in a "TextBuffer".
--
-- TODO
--
-- * accessor functions for TextAttributes

module TextTag(
  TextTag,
  TextTagClass,
  castToTextTag,
  TagName,
  textTagNew,
  textTagSetPriority,
  textTagGetPriority,
  TextAttributes(..),
  textAttributesNew,
  makeNewTextAttributes,  --internal
  ) where

import Monad	(liftM)
import FFI

import GObject	(makeNewGObject)
{#import Hierarchy#}
{#import Signal#}

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

type TagName = String

-- TextTag methods

-- | Creates a 'TextTag'.
--
textTagNew :: TagName -> IO TextTag
textTagNew name =
  withCString name $ \strPtr ->
  makeNewGObject mkTextTag $ {#call unsafe text_tag_new#} strPtr

-- | Get the tag priority.
--
textTagGetPriority :: TextTagClass obj => obj -> IO Int
textTagGetPriority obj = liftM fromIntegral $
  {#call unsafe text_tag_get_priority#} (toTextTag obj)

-- | Sets the priority of a 'TextTag'.
--
-- Valid priorities are start at 0 and go to one less than
-- 'textTagTableGetSize'. Each tag in a table has a unique priority; setting the
-- priority of one tag shifts the priorities of all the other tags in the table
-- to maintain a unique priority for each tag. Higher priority tags \"win\" if
-- two tags both set the same text attribute. When adding a tag to a tag table,
-- it will be assigned the highest priority in the table by default; so normally
-- the precedence of a set of tags is the order in which they were added to the
-- table, or created with 'textBufferCreateTag', which adds the tag to the
-- buffer's table automatically.
--
textTagSetPriority :: TextTagClass obj => obj -> Int -> IO ()
textTagSetPriority obj priority =
  {#call text_tag_set_priority#} (toTextTag obj) (fromIntegral priority)


-- TextAttributes methods

{#pointer * TextAttributes foreign newtype#}

-- | Creates a 'TextAttributes', which describes a set of properties on some
-- text.
--
textAttributesNew :: IO TextAttributes
textAttributesNew =
  {#call unsafe text_attributes_new#} >>= makeNewTextAttributes

makeNewTextAttributes :: Ptr TextAttributes -> IO TextAttributes
makeNewTextAttributes ptr =
  liftM TextAttributes $ newForeignPtr ptr (text_attributes_unref ptr)

#if __GLASGOW_HASKELL__>=600
                                                                                
foreign import ccall unsafe "&gtk_text_attributes_unref"
  text_attributes_unref' :: FinalizerPtr TextAttributes
                                                                                
text_attributes_unref :: Ptr TextAttributes -> FinalizerPtr TextAttributes
text_attributes_unref _ = text_attributes_unref'
                                                                                
#elif __GLASGOW_HASKELL__>=504
                                                                                
foreign import ccall unsafe "gtk_text_attributes_unref"
  text_attributes_unref :: Ptr TextAttributes -> IO ()
                                                                                
#else
                                                                                
foreign import ccall "gtk_text_attributes_unref" unsafe
  text_attributes_unref :: Ptr TextAttributes -> IO ()
                                                                                
#endif

--- TextIter.chs DELETED ---

--- NEW FILE: TextIter.chspp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) TextIter TextBuffer
--
--  Author : Axel Simon
--          
--  Created: 23 February 2002
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/24 17:19:24 $
--
--  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.
--
-- |
--
-- An iterator is an abstract datatype representing a pointer into a 
-- 'TextBuffer'.
--
-- * The following functions do not make sense due to Haskell's wide character
--   representation of Unicode:
--     gtk_text_iter_get_line_index
--     gtk_text_iter_get_visible_line_index
--     gtk_text_iter_get_bytes_in_line
--     gtk_text_iter_set_line_index
--     gtk_text_iter_set_visible_line_index
--
-- * The functions gtk_text_iter_in_range and gtk_text_iter_order are not bound
--   because they are only convenience functions which can replaced by calls
--   to textIterCompare.
--
-- * All offsets are counted from 0.
--
-- TODO
--
-- * Bind the following function when GSList is bound:
--     gtk_text_iter_get_marks
--     gtk_text_iter_get_toggled_tags
--     gtk_text_iter_get_tags
--
-- * Bind the following functions when we are sure about anchors 
--   (see 'TextBuffer'):
--     gtk_text_iter_get_anchor
--
-- * Bind TextAttribute functions when I am clear how to model them. 
--     gtk_text_iter_get_attribute
--
-- * Forward exceptions in the two callback functions.
--
module TextIter(
  TextIter(TextIter),
  mkTextIter,
  makeEmptyTextIter,	-- for internal use only
  textIterGetBuffer,
  textIterCopy,
  textIterGetOffset,
  textIterGetLine,
  textIterGetLineOffset,
  textIterGetVisibleLineOffset,
  textIterGetChar,
  textIterGetSlice,
  textIterGetText,
  textIterGetVisibleSlice,
  textIterGetVisibleText,
  textIterGetPixbuf,
  textIterBeginsTag,
  textIterEndsTag,
  textIterTogglesTag,
  textIterHasTag,
  textIterEditable,
  textIterCanInsert,
  textIterStartsWord,
  textIterEndsWord,
  textIterInsideWord,
  textIterStartsLine,
  textIterEndsLine,
  textIterStartsSentence,
  textIterEndsSentence,
  textIterInsideSentence,
  textIterIsCursorPosition,
  textIterGetCharsInLine,
  textIterIsEnd,
  textIterIsStart,
  textIterForwardChar,
  textIterBackwardChar,
  textIterForwardChars,
  textIterBackwardChars,
  textIterForwardLine,
  textIterBackwardLine,
  textIterForwardLines,
  textIterBackwardLines,
  textIterForwardWordEnds,
  textIterBackwardWordStarts,
  textIterForwardWordEnd,
  textIterBackwardWordStart,
  textIterForwardCursorPosition,
  textIterBackwardCursorPosition,
  textIterForwardCursorPositions,
  textIterBackwardCursorPositions,
  textIterForwardSentenceEnds,
  textIterBackwardSentenceStarts,
  textIterForwardSentenceEnd,
  textIterBackwardSentenceStart,
  textIterSetOffset,
  textIterSetLine,
  textIterSetLineOffset,
  textIterSetVisibleLineOffset,
  textIterForwardToEnd,
  textIterForwardToLineEnd,
  textIterForwardToTagToggle,
  textIterBackwardToTagToggle,
  textIterForwardFindChar,
  textIterBackwardFindChar,
  textIterForwardSearch,
  textIterBackwardSearch,
  textIterEqual,
  textIterCompare
  ) where

import Monad	(liftM)
import Maybe	(fromMaybe)
import Char	(chr)
import FFI
import GObject	(makeNewGObject)
{#import Hierarchy#}
{#import Signal#}
import Structs  (textIterSize)
import Enums	(TextSearchFlags, Flags(fromFlags))

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

-- methods

{#pointer *TextIter foreign newtype #}

-- Create a TextIter from a pointer.
--
mkTextIter :: Ptr TextIter -> IO TextIter
mkTextIter iterPtr = liftM TextIter $ 
  newForeignPtr iterPtr (text_iter_free iterPtr)

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&gtk_text_iter_free"
  text_iter_free' :: FinalizerPtr TextIter

text_iter_free :: Ptr TextIter -> FinalizerPtr TextIter
text_iter_free _ = text_iter_free'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gtk_text_iter_free"
  text_iter_free :: Ptr TextIter -> IO ()

#else

foreign import ccall "gtk_text_iter_free" unsafe
  text_iter_free :: Ptr TextIter -> IO ()

#endif

-- Allocate memory to be filled with a TextIter.
--
makeEmptyTextIter :: IO TextIter
makeEmptyTextIter = do
  iterPtr <- mallocBytes textIterSize
  liftM TextIter $ newForeignPtr iterPtr (text_iter_free iterPtr)

-- | Return the 'TextBuffer' this iterator
-- is associated with.
--
textIterGetBuffer :: TextIter -> IO TextBuffer
textIterGetBuffer ti = makeNewGObject mkTextBuffer $
  {#call unsafe text_iter_get_buffer#} ti

-- | Copy the iterator.
--
textIterCopy :: TextIter -> IO TextIter
textIterCopy ti = do
  iterPtr <- {#call unsafe text_iter_copy#} ti
  liftM TextIter $ newForeignPtr iterPtr (text_iter_free iterPtr)

-- | Extract the offset relative to the beginning of
-- the buffer.
--
textIterGetOffset :: TextIter -> IO Int
textIterGetOffset ti = liftM fromIntegral $
  {#call unsafe text_iter_get_offset#} ti

-- | Extract the line of the buffer.
--
textIterGetLine :: TextIter -> IO Int
textIterGetLine ti = liftM fromIntegral $
  {#call unsafe text_iter_get_line#} ti

-- | Extract the offset relative to the beginning
-- of the line.
--
textIterGetLineOffset :: TextIter -> IO Int
textIterGetLineOffset ti = liftM fromIntegral $
  {#call unsafe text_iter_get_line_offset#} ti

-- | Extract the offset relative to the
-- beginning of the line skipping invisible parts of the line.
--
textIterGetVisibleLineOffset :: TextIter -> IO Int
textIterGetVisibleLineOffset ti = liftM fromIntegral $
  {#call unsafe text_iter_get_visible_line_offset#} ti

-- | Return the character at this iterator.
--
textIterGetChar :: TextIter -> IO (Maybe Char)
textIterGetChar ti = do
  (res::Int) <- liftM fromIntegral $ {#call unsafe text_iter_get_char#} ti
  return $ if res==0 then Nothing else Just (chr res)

-- | Return the text in a given range.
--
-- * Pictures (and other objects) are represented by 0xFFFC.
--
textIterGetSlice :: TextIter -> TextIter -> IO String
textIterGetSlice end start = do
  cStr <- {#call text_iter_get_slice#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- | Return the text in a given range.
--
-- * Pictures (and other objects) are stripped form the output.
--
textIterGetText :: TextIter -> TextIter -> IO String
textIterGetText start end = do
  cStr <- {#call text_iter_get_text#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- | Return the visible text in a given range.
--
-- * Pictures (and other objects) are represented by 0xFFFC.
--
textIterGetVisibleSlice :: TextIter -> TextIter -> IO String
textIterGetVisibleSlice start end = do
  cStr <- {#call text_iter_get_visible_slice#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- | Return the visible text in a given range.
--
-- * Pictures (and other objects) are stripped form the output.
--
textIterGetVisibleText :: TextIter -> TextIter -> IO String
textIterGetVisibleText start end = do
  cStr <- {#call text_iter_get_visible_text#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- | Get the 'Pixbuf' under the iterator.
--
textIterGetPixbuf :: TextIter -> IO (Maybe Pixbuf)
textIterGetPixbuf it = do
  pbPtr <- {#call unsafe text_iter_get_pixbuf#} it
  if pbPtr==nullPtr then return Nothing else liftM Just $
    makeNewGObject mkPixbuf (return pbPtr)


-- | Query whether a 'TextIter' is at the
-- start of a 'TextTag'.
--
textIterBeginsTag :: TextIter -> TextTag -> IO Bool
textIterBeginsTag ti tt = liftM toBool $
  {#call unsafe text_iter_begins_tag#} ti tt


-- | Query whether a 'TextIter' is at the end
-- of a 'TextTag'.
--
textIterEndsTag :: TextIter -> TextTag -> IO Bool
textIterEndsTag ti tt = liftM toBool $
  {#call unsafe text_iter_ends_tag#} ti tt

-- | Query if the 'TextIter' is at the
-- beginning or the end of a 'TextTag'.
--
textIterTogglesTag :: TextIter -> TextTag -> IO Bool
textIterTogglesTag ti tt = liftM toBool $
  {#call unsafe text_iter_toggles_tag#} ti tt

-- | Check if 'TextIter' is within a range
-- tagged with tag.
--
textIterHasTag :: TextIter -> TextTag -> IO Bool
textIterHasTag ti tt = liftM toBool $
  {#call unsafe text_iter_has_tag#} ti tt

-- | Check if 'TextIter' is within an
-- editable region.
--
-- * If no tags that affect editability are attached to the current position
--   @def@ will be returned.
--
-- * This function cannot be used to decide whether text can be inserted at
--   'TextIter'. Use the 'textIterCanInsert' function for
--   this purpose.
--
textIterEditable :: TextIter -> Bool -> IO Bool
textIterEditable ti def = liftM toBool $ 
  {#call unsafe text_iter_editable#} ti (fromBool def)

-- | Check if new text can be inserted at
-- 'TextIter'.
--
-- * Use 'textBufferInsertInteractive' if you want to insert text
--   depending on the current editable status.
--
textIterCanInsert :: TextIter -> Bool -> IO Bool
textIterCanInsert ti def = liftM toBool $ 
  {#call unsafe text_iter_can_insert#} ti (fromBool def)

-- | Determine if 'TextIter' begins a new
-- natural-language word.
--
textIterStartsWord :: TextIter -> IO Bool
textIterStartsWord ti = liftM toBool $ {#call unsafe text_iter_starts_word#} ti


-- | Determine if 'TextIter' ends a new
-- natural-language word.
--
textIterEndsWord :: TextIter -> IO Bool
textIterEndsWord ti = liftM toBool $ {#call unsafe text_iter_ends_word#} ti

-- | Determine if 'TextIter' is inside a
-- word.
--
textIterInsideWord :: TextIter -> IO Bool
textIterInsideWord ti = liftM toBool $ {#call unsafe text_iter_inside_word#} ti

-- | Determine if 'TextIter' begins a new
-- line.
--
textIterStartsLine :: TextIter -> IO Bool
textIterStartsLine ti = liftM toBool $ {#call unsafe text_iter_starts_line#} ti

-- | Determine if 'TextIter' point to the
-- beginning of a line delimiter.
--
-- * Returns False if 'TextIter' points to the \n in a \r\n sequence.
--
textIterEndsLine :: TextIter -> IO Bool
textIterEndsLine ti = liftM toBool $ {#call unsafe text_iter_ends_line#} ti

-- | Determine if 'TextIter' starts a
-- sentence.
--
textIterStartsSentence :: TextIter -> IO Bool
textIterStartsSentence ti = liftM toBool $ 
  {#call unsafe text_iter_starts_sentence#} ti

-- | Determine if 'TextIter' ends a
-- sentence.
--
textIterEndsSentence :: TextIter -> IO Bool
textIterEndsSentence ti = liftM toBool $ 
  {#call unsafe text_iter_ends_sentence#} ti

-- | Determine if 'TextIter' is inside
-- a sentence.
--
textIterInsideSentence :: TextIter -> IO Bool
textIterInsideSentence ti = liftM toBool $ 
  {#call unsafe text_iter_inside_sentence#} ti

-- | Determine if 'TextIter' is at a
-- cursor position.
--
textIterIsCursorPosition :: TextIter -> IO Bool
textIterIsCursorPosition ti = liftM toBool $ 
  {#call unsafe text_iter_is_cursor_position#} ti

-- | Return number of characters in this line.
--
-- * The return value includes delimiters.
--
textIterGetCharsInLine :: TextIter -> IO Int
textIterGetCharsInLine ti = liftM fromIntegral $
  {#call unsafe text_iter_get_chars_in_line#} ti

-- | Get the text attributes at the iterator.
--
-- * The @ta@ argument gives the default values if no specific 
--   attributes are set at that specific location.
--
-- * The function returns @Nothing@ if the text at the iterator has 
--   the same attributes.
textIterGetAttributes = undefined

-- | Determine if 'TextIter' is at the end of
-- the buffer.
--
textIterIsEnd :: TextIter -> IO Bool
textIterIsEnd ti = liftM toBool $ 
  {#call unsafe text_iter_is_end#} ti

-- | Determine if 'TextIter' is at the
-- beginning of the buffer.
--
textIterIsStart :: TextIter -> IO Bool
textIterIsStart ti = liftM toBool $ 
  {#call unsafe text_iter_is_start#} ti

-- | Move 'TextIter' forwards.
--
-- * Retuns True if the iterator is pointing to a character.
--
textIterForwardChar :: TextIter -> IO Bool
textIterForwardChar ti = liftM toBool $ 
  {#call unsafe text_iter_forward_char#} ti

-- | Move 'TextIter' backwards.
--
-- * Retuns True if the movement was possible.
--
textIterBackwardChar :: TextIter -> IO Bool
textIterBackwardChar ti = liftM toBool $ 
  {#call unsafe text_iter_backward_char#} ti

-- | Move 'TextIter' forwards by
-- @n@ characters.
--
-- * Retuns True if the iterator is pointing to a new character (and False if
--   the iterator points to a picture or has not moved).
--
textIterForwardChars :: TextIter -> Int -> IO Bool
textIterForwardChars ti n = liftM toBool $ 
  {#call unsafe text_iter_forward_chars#} ti (fromIntegral n)

-- | Move 'TextIter' backwards by
-- @n@ characters.
--
-- * Retuns True if the iterator is pointing to a new character (and False if
--   the iterator points to a picture or has not moved).
--
textIterBackwardChars :: TextIter -> Int -> IO Bool
textIterBackwardChars ti n = liftM toBool $ 
  {#call unsafe text_iter_backward_chars#} ti (fromIntegral n)


-- | Move 'TextIter' forwards.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If 'TextIter' is on the first line, it will be moved to the
--   beginning of the buffer.
--
textIterForwardLine :: TextIter -> IO Bool
textIterForwardLine ti = liftM toBool $ 
  {#call unsafe text_iter_forward_line#} ti

-- | Move 'TextIter' backwards.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If 'TextIter' is on the first line, it will be moved to the end
--   of the buffer.
--
textIterBackwardLine :: TextIter -> IO Bool
textIterBackwardLine ti = liftM toBool $ 
  {#call unsafe text_iter_backward_line#} ti


-- | Move 'TextIter' forwards by
-- @n@ lines.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If 'TextIter' is on the first line, it will be moved to the
--   beginning of the buffer.
--
-- * @n@ can be negative.
--
textIterForwardLines :: TextIter -> Int -> IO Bool
textIterForwardLines ti n = liftM toBool $ 
  {#call unsafe text_iter_forward_lines#} ti (fromIntegral n)

-- | Move 'TextIter' backwards by
-- @n@ lines.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If 'TextIter' is on the first line, it will be moved to the end
--   of the buffer.
--
-- * @n@ can be negative.
--
textIterBackwardLines :: TextIter -> Int -> IO Bool
textIterBackwardLines ti n = liftM toBool $ 
  {#call unsafe text_iter_backward_lines#} ti (fromIntegral n)

-- | Move 'TextIter' forwards by
-- @n@ word ends.
--
-- * Retuns True if the iterator is pointing to a new word end.
--
textIterForwardWordEnds :: TextIter -> Int -> IO Bool
textIterForwardWordEnds ti n = liftM toBool $ 
  {#call unsafe text_iter_forward_word_ends#} ti (fromIntegral n)

-- | Move 'TextIter' backwards by
-- @n@ word beginnings.
--
-- * Retuns True if the iterator is pointing to a new word start.
--
textIterBackwardWordStarts :: TextIter -> Int -> IO Bool
textIterBackwardWordStarts ti n = liftM toBool $ 
  {#call unsafe text_iter_backward_word_starts#} ti (fromIntegral n)

-- | Move 'TextIter' forwards to the
-- next word end.
--
-- * Retuns True if the iterator has moved to a new word end.
--
textIterForwardWordEnd :: TextIter -> IO Bool
textIterForwardWordEnd ti = liftM toBool $ 
  {#call unsafe text_iter_forward_word_end#} ti

-- | Move 'TextIter' backwards to
-- the next word beginning.
--
-- * Retuns True if the iterator has moved to a new word beginning.
--
textIterBackwardWordStart :: TextIter -> IO Bool
textIterBackwardWordStart ti = liftM toBool $ 
  {#call unsafe text_iter_backward_word_start#} ti

-- | Move 'TextIter' forwards to
-- the next cursor position.
--
-- * Some characters are composed of two Unicode codes. This function ensures
--   that 'TextIter' does not point inbetween such double characters.
--
-- * Returns True if 'TextIter' moved and points to a character (not
--   to an object).
--
textIterForwardCursorPosition :: TextIter -> IO Bool
textIterForwardCursorPosition ti = liftM toBool $
  {#call unsafe text_iter_forward_cursor_position#} ti

-- | Move 'TextIter' backwards
-- to the next cursor position.
--
-- * Some characters are composed of two Unicode codes. This function ensures
--   that 'TextIter' does not point inbetween such double characters.
--
-- * Returns True if 'TextIter' moved and points to a character (not
--   to an object).
--
textIterBackwardCursorPosition :: TextIter -> IO Bool
textIterBackwardCursorPosition ti = liftM toBool $
  {#call unsafe text_iter_backward_cursor_position#} ti

-- | Move 'TextIter' forwards
-- by @n@ cursor positions.
--
-- * Returns True if 'TextIter' moved and points to a character (not
--   to an object).
--
textIterForwardCursorPositions :: TextIter -> Int -> IO Bool
textIterForwardCursorPositions ti n = liftM toBool $ 
  {#call unsafe text_iter_forward_cursor_positions#} ti (fromIntegral n)

-- | Move 'TextIter' backwards
-- by @n@ cursor positions.
--
-- * Returns True if 'TextIter' moved and points to a character (not
--   to an object).
--
textIterBackwardCursorPositions :: TextIter -> Int -> IO Bool
textIterBackwardCursorPositions ti n = liftM toBool $ 
  {#call unsafe text_iter_backward_cursor_positions#} ti (fromIntegral n)


-- | Move 'TextIter' forwards by
-- @n@ sentence ends.
--
-- * Retuns True if the iterator is pointing to a new sentence end.
--
textIterForwardSentenceEnds :: TextIter -> Int -> IO Bool
textIterForwardSentenceEnds ti n = liftM toBool $ 
  {#call unsafe text_iter_forward_sentence_ends#} ti (fromIntegral n)

-- | Move 'TextIter' backwards
-- by @n@ sentence beginnings.
--
-- * Retuns True if the iterator is pointing to a new sentence start.
--
textIterBackwardSentenceStarts :: TextIter -> Int -> IO Bool
textIterBackwardSentenceStarts ti n = liftM toBool $ 
  {#call unsafe text_iter_backward_sentence_starts#} ti (fromIntegral n)

-- | Move 'TextIter' forwards to
-- the next sentence end.
--
-- * Retuns True if the iterator has moved to a new sentence end.
--
textIterForwardSentenceEnd :: TextIter -> IO Bool
textIterForwardSentenceEnd ti = liftM toBool $ 
  {#call unsafe text_iter_forward_sentence_end#} ti

-- | Move 'TextIter' backwards
-- to the next sentence beginning.
--
-- * Retuns True if the iterator has moved to a new sentence beginning.
--
textIterBackwardSentenceStart :: TextIter -> IO Bool
textIterBackwardSentenceStart ti = liftM toBool $ 
  {#call unsafe text_iter_backward_sentence_start#} ti

-- | Set 'TextIter' to an offset within the
-- buffer.
--
textIterSetOffset :: TextIter -> Int -> IO ()
textIterSetOffset ti n = 
  {#call unsafe text_iter_set_offset#} ti (fromIntegral n)

-- | Set 'TextIter' to a line within the
-- buffer.
--
textIterSetLine :: TextIter -> Int -> IO ()
textIterSetLine ti n = 
  {#call unsafe text_iter_set_line#} ti (fromIntegral n)

-- | Set 'TextIter' to an offset within
-- the line.
--
textIterSetLineOffset :: TextIter -> Int -> IO ()
textIterSetLineOffset ti n = 
  {#call unsafe text_iter_set_line_offset#} ti (fromIntegral n)

-- | Set 'TextIter' to an visible
-- character within the line.
--
textIterSetVisibleLineOffset :: TextIter -> Int -> IO ()
textIterSetVisibleLineOffset ti n = 
  {#call unsafe text_iter_set_visible_line_offset#} ti (fromIntegral n)

-- | Moves 'TextIter' to the end of the
-- buffer.
--
textIterForwardToEnd :: TextIter -> IO ()
textIterForwardToEnd ti = {#call unsafe text_iter_forward_to_end#} ti

-- | Moves 'TextIter' to the end of
-- the line.
--
-- * Returns True if 'TextIter' moved to a new location which is not
--   the buffer end iterator.
--
textIterForwardToLineEnd :: TextIter -> IO Bool
textIterForwardToLineEnd ti = liftM toBool $
  {#call unsafe text_iter_forward_to_line_end#} ti

-- | Moves 'TextIter' forward to
-- the next change of a 'TextTag'.
--
-- * If Nothing is supplied, any 'TextTag' will be matched.
--
-- * Returns True if there was a tag toggle after 'TextIter'.
--
textIterForwardToTagToggle :: TextIter -> Maybe TextTag -> IO Bool
textIterForwardToTagToggle ti tt = liftM toBool $
  {#call unsafe text_iter_forward_to_tag_toggle#} ti 
    (fromMaybe (mkTextTag nullForeignPtr) tt)

-- | Moves 'TextIter' backward to
-- the next change of a 'TextTag'.
--
-- * If Nothing is supplied, any 'TextTag' will be matched.
--
-- * Returns True if there was a tag toggle before 'TextIter'.
--
textIterBackwardToTagToggle :: TextIter -> Maybe TextTag -> IO Bool
textIterBackwardToTagToggle ti tt = liftM toBool $
  {#call unsafe text_iter_backward_to_tag_toggle#} ti 
    (fromMaybe (mkTextTag nullForeignPtr) tt)

-- Setup a callback for a predicate function.
--
type TextCharPredicateCB = Char -> Bool

{#pointer TextCharPredicate#}

foreign import ccall "wrapper" mkTextCharPredicate ::
  ({#type gunichar#} -> Ptr () -> {#type gboolean#}) -> IO TextCharPredicate

-- | Move 'TextIter' forward until a
-- predicate function returns True.
--
-- * If @pred@ returns True before @limit@ is reached, the
--   search is stopped and the return value is True.
--
-- * If @limit@ is Nothing, the search stops at the end of the buffer.
--
textIterForwardFindChar :: TextIter -> (Char -> Bool) -> Maybe TextIter ->
                           IO Bool
textIterForwardFindChar ti pred limit = do
  fPtr <- mkTextCharPredicate (\c _ -> fromBool $ pred (chr (fromIntegral c)))
  res <- liftM toBool $ {#call text_iter_forward_find_char#} 
    ti fPtr nullPtr (fromMaybe (TextIter nullForeignPtr) limit)
  freeHaskellFunPtr fPtr
  return res

-- | Move 'TextIter' backward until a
-- predicate function returns True.
--
-- * If @pred@ returns True before @limit@ is reached, the
--   search is stopped and the return value is True.
--
-- * If @limit@ is Nothing, the search stops at the end of the buffer.
--
textIterBackwardFindChar :: TextIter -> (Char -> Bool) -> Maybe TextIter ->
                            IO Bool
textIterBackwardFindChar ti pred limit = do
  fPtr <- mkTextCharPredicate (\c _ -> fromBool $ pred (chr (fromIntegral c)))
  res <- liftM toBool $ {#call text_iter_backward_find_char#} 
    ti fPtr nullPtr (fromMaybe (TextIter nullForeignPtr) limit)
  freeHaskellFunPtr fPtr
  return res

-- | Search forward for a specific string.
--
-- * If specified, the last character which is tested against that start of
--   the search pattern will be @limit@.
--
-- * 'TextSearchFlags' may be empty.
--
-- * Returns the start and end position of the string found.
--
textIterForwardSearch :: TextIter -> String -> [TextSearchFlags] ->
                         Maybe TextIter -> IO (Maybe (TextIter, TextIter))
textIterForwardSearch ti str flags limit = do
  start  <- makeEmptyTextIter
  end <- makeEmptyTextIter
  found <- liftM toBool $ withUTFString str $ \cStr ->
    {#call unsafe text_iter_forward_search#} ti cStr 
    ((fromIntegral.fromFlags) flags) start end 
    (fromMaybe (TextIter nullForeignPtr) limit)
  return $ if found then Just (start,end) else Nothing

-- | Search backward for a specific string.
--
-- * If specified, the last character which is tested against that start of
--   the search pattern will be @limit@.
--
-- * 'TextSearchFlags' my be empty.
--
-- * Returns the start and end position of the string found.
--
textIterBackwardSearch :: TextIter -> String -> [TextSearchFlags] ->
                          Maybe TextIter -> IO (Maybe (TextIter, TextIter))
textIterBackwardSearch ti str flags limit = do
  start  <- makeEmptyTextIter
  end <- makeEmptyTextIter
  found <- liftM toBool $ withUTFString str $ \cStr ->
    {#call unsafe text_iter_backward_search#} ti cStr 
    ((fromIntegral.fromFlags) flags) start end 
    (fromMaybe (TextIter nullForeignPtr) limit)
  return $ if found then Just (start,end) else Nothing

-- | Compare two 'TextIter' for equality.
--
-- * 'TextIter' could be in class Eq and Ord if there is a guarantee
--   that each iterator is copied before it is modified in place. This is done
--   the next abstraction layer.
--
textIterEqual :: TextIter -> TextIter -> IO Bool
textIterEqual ti2 ti1 = liftM toBool $ {#call unsafe text_iter_equal#} ti1 ti2

-- | Compare two 'TextIter'.
--
-- * 'TextIter' could be in class Eq and Ord if there is a guarantee
--   that each iterator is copied before it is modified in place. This could
--   be done the next abstraction layer.
--
textIterCompare :: TextIter -> TextIter -> IO Ordering
textIterCompare ti2 ti1 = do
  res <- {#call unsafe text_iter_compare#} ti1 ti2
  return $ case res of
    (-1)   -> LT
    0	   -> EQ
    1	   -> GT

[Gtk2hs-commit] gtk2hs/gtk/pango PangoTypes.chspp,NONE,1.1 PangoTypes.chs,1.4,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/pango
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28086/gtk/pango

Added Files:
	PangoTypes.chspp 
Removed Files:
	PangoTypes.chs 
Log Message:
New build system.


--- PangoTypes.chs DELETED ---

--- NEW FILE: PangoTypes.chspp ---
--  GIMP Toolkit (GTK) - pango non-GObject types PangoTypes
--
--  Author : Axel Simon
--          
--  Created: 9 Feburary 2003
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/24 17:19:24 $
--
--  Copyright (c) 1999..2003 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.
--
-- |
--
-- Define types used in Pango which are not derived from GObject.
--
module PangoTypes(
  LayoutIter(LayoutIter),
  layout_iter_free,
  LayoutLine(LayoutLine),
  mkLayoutLine
  ) where

import Monad    (liftM)
import FFI

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

-- entry PangoLayout

-- | An iterator to examine a layout.
--
{#pointer *PangoLayoutIter as LayoutIter foreign newtype #}

-- | A single line in a 'PangoLayout'.
--
{#pointer *PangoLayoutLine as LayoutLine foreign newtype #}

mkLayoutLine :: Ptr LayoutLine -> IO LayoutLine
mkLayoutLine llPtr = do
  pango_layout_line_ref llPtr
  liftM LayoutLine $ newForeignPtr llPtr (pango_layout_line_unref llPtr)


#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&pango_layout_iter_free"
  layout_iter_free' :: FinalizerPtr LayoutIter

layout_iter_free :: Ptr LayoutIter -> FinalizerPtr LayoutIter
layout_iter_free _ = layout_iter_free'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "pango_layout_iter_free"
  layout_iter_free :: Ptr LayoutIter -> IO ()

#else

foreign import ccall "pango_layout_iter_free" unsafe
  layout_iter_free :: Ptr LayoutIter -> IO ()

#endif

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&pango_layout_line_unref"
  pango_layout_line_unref' :: FinalizerPtr LayoutLine

pango_layout_line_unref :: Ptr LayoutLine -> FinalizerPtr LayoutLine
pango_layout_line_unref _ = pango_layout_line_unref'

#elif __GLASGOW_HASKELL__>=504

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

#else

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

#endif

#if __GLASGOW_HASKELL__>=504

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

#else

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

#endif

[Gtk2hs-commit] gtk2hs/gtk/layout Alignment.chspp,NONE,1.1 Expander.chspp,NONE,1.1 Notebook.chspp,NONE,1.1 Alignment.chs,1.5,NONE Expander.chs,1.4,NONE Notebook.chs,1.10,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/layout
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28086/gtk/layout

Added Files:
	Alignment.chspp Expander.chspp Notebook.chspp 
Removed Files:
	Alignment.chs Expander.chs Notebook.chs 
Log Message:
New build system.


--- NEW FILE: Notebook.chspp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Notebook
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/24 17:19:22 $
--
--  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.
--
-- |
--
-- This widget can display several pages of widgets. Each page can be selected
-- by a tab at the top of the widget. It is useful in dialogs where a lot of
-- information has to be displayed.
--
-- TODO
--
-- * The signals focus-tab and select-page are not bound because it is unclear
--   what they mean. As far as I can see they are not emitted anywhere.
--
module Notebook(
  Notebook,
  NotebookClass,
  castToNotebook,
  notebookNew,
  notebookAppendPage,
  notebookAppendPageMenu,
  notebookPrependPage,
  notebookPrependPageMenu,
  notebookInsertPage,
  notebookInsertPageMenu,
  notebookRemovePage,
  notebookPageNum,
  notebookSetCurrentPage,
  notebookNextPage,
  notebookPrevPage,
  notebookReorderChild,
  PositionType(..),
  notebookSetTabPos,
  notebookGetTabPos,
  notebookSetShowTabs,
  notebookGetShowTabs,
  notebookSetShowBorder,
  notebookSetScrollable,
  notebookGetScrollable,
#ifndef DISABLE_DEPRECATED
  notebookSetTabBorder,
  notebookSetTabHBorder,
  notebookSetTabVBorder,
#endif
  notebookSetPopup,
  notebookGetCurrentPage,
  notebookSetMenuLabel,
  notebookGetMenuLabel,
  notebookSetMenuLabelText,
  notebookGetMenuLabelText,
  notebookGetNthPage,
#if GTK_CHECK_VERSION(2,2,0)
  notebookGetNPages,
#endif
  notebookGetTabLabel,
  notebookGetTabLabelText,
  Packing(..), PackType(..),
  notebookQueryTabLabelPacking,
  notebookSetTabLabelPacking,
#ifndef DISABLE_DEPRECATED
  notebookSetHomogeneousTabs,
#endif
  notebookSetTabLabel,
  notebookSetTabLabelText,
  onSwitchPage,
  afterSwitchPage
  ) where

import Monad	(liftM)
import Maybe	(maybe)
import FFI

import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}
import Label	(labelNew)
import Enums	(Packing(..), PackType(..), PositionType(..))

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

-- methods

-- | Create a new notebook.
--
notebookNew :: IO Notebook
notebookNew  = makeNewObject mkNotebook $ 
  liftM castPtr {#call unsafe notebook_new#}

#if GTK_CHECK_VERSION(2,4,0)
-- | Insert a new tab to the right of the existing tabs.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context menu is enabled, this name will also appear in the popup menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookAppendPageMenu'.
--
-- * Returns index (starting from 0) of the appended page in the notebook, or -1
-- if the function fails.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookAppendPage :: (NotebookClass nb, WidgetClass child) => nb
                   -> child   -- ^ Widget to use as the contents of the page
                   -> String  -- ^ Label for the page.
                   -> IO Int
notebookAppendPage nb child tabLabel = do
  tab <- labelNew (Just tabLabel)
  liftM fromIntegral $
    {#call notebook_append_page#} (toNotebook nb) (toWidget child) 
      (toWidget tab)

#else
-- | Insert a new tab to the right of the existing tabs.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context popup menu is enabled, this name will also appear in the menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookAppendPageMenu'.
--
-- * This function returns @Int@ in Gtk version 2.4.0 and later.
--
notebookAppendPage :: (NotebookClass nb, WidgetClass child) => nb
                   -> child   -- ^ Widget to use as the contents of the page
                   -> String  -- ^ Label for the page.
                   -> IO ()
notebookAppendPage nb child tabLabel = do
  tab <- labelNew (Just tabLabel)
  {#call notebook_append_page#} (toNotebook nb) (toWidget child) (toWidget tab)
#endif

#if GTK_CHECK_VERSION(2,4,0)
-- | Insert a new tab to the right of the existing tabs.
--
-- Like 'notebookAppendPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * Returns the index (starting from 0) of the appended page in the notebook,
-- or -1 if the function fails.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookAppendPageMenu :: (NotebookClass nb, WidgetClass child,
   WidgetClass tab, WidgetClass menu) => nb
  -> child  -- ^ Widget to use as the contents of the page
  -> tab    -- ^ Tab label widget for the page.
  -> menu   -- ^ Menu entry for this tab (usually a 'Label' widget).
  -> IO Int
notebookAppendPageMenu nb child tabWidget menuWidget = liftM fromIntegral $
  {#call notebook_append_page_menu#} (toNotebook nb) (toWidget child)
    (toWidget tabWidget) (toWidget menuWidget)

#else
-- | Insert a new tab to the right of the existing tabs.
--
-- Like 'notebookAppendPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * This function returns @Int@ in Gtk version 2.4.0 and later
--
notebookAppendPageMenu :: (NotebookClass nb, WidgetClass child,
   WidgetClass tab, WidgetClass menu) => nb
  -> child  -- ^ Widget to use as the contents of the page
  -> tab    -- ^ Tab label widget for the page.
  -> menu   -- ^ Menu entry for this tab (usually a 'Label' widget).
  -> IO ()
notebookAppendPageMenu nb child tabWidget menuWidget =
  {#call notebook_append_page_menu#} (toNotebook nb) (toWidget child)
    (toWidget tabWidget) (toWidget menuWidget)
#endif

#if GTK_CHECK_VERSION(2,4,0)
-- | Insert a new tab to the left of the existing tabs.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context menu is enabled, this name will also appear in the popup menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookPrependPageMenu'.
--
-- * Returns index (starting from 0) of the prepended page in the notebook, or -1
-- if the function fails.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookPrependPage :: (NotebookClass nb, WidgetClass child) => nb
                   -> child   -- ^ Widget to use as the contents of the page
                   -> String  -- ^ Label for the page.
                   -> IO Int
notebookPrependPage nb child tabLabel = do
  tab <- labelNew (Just tabLabel)
  liftM fromIntegral $
    {#call notebook_prepend_page#} (toNotebook nb) (toWidget child) 
      (toWidget tab)

#else
-- | Insert a new tab to the left of the existing tabs.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context popup menu is enabled, this name will also appear in the menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookPrependPageMenu'.
--
-- * This function returns @Int@ in Gtk version 2.4.0 and later.
--
notebookPrependPage :: (NotebookClass nb, WidgetClass child) => nb
                   -> child   -- ^ Widget to use as the contents of the page
                   -> String  -- ^ Label for the page.
                   -> IO ()
notebookPrependPage nb child tabLabel = do
  tab <- labelNew (Just tabLabel)
  {#call notebook_prepend_page#} (toNotebook nb) (toWidget child) 
    (toWidget tab)
#endif

#if GTK_CHECK_VERSION(2,4,0)
-- | Insert a new tab to the left of the existing tabs.
--
-- Like 'notebookPrependPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * Returns the index (starting from 0) of the prepended page in the notebook,
-- or -1 if the function fails.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookPrependPageMenu :: (NotebookClass nb, WidgetClass child,
   WidgetClass tab, WidgetClass menu) => nb
  -> child  -- ^ Widget to use as the contents of the page
  -> tab    -- ^ Tab label widget for the page.
  -> menu   -- ^ Menu entry for this tab (usually a 'Label' widget).
  -> IO Int
notebookPrependPageMenu nb child tabWidget menuWidget = liftM fromIntegral $
  {#call notebook_prepend_page_menu#} (toNotebook nb) (toWidget child)
    (toWidget tabWidget) (toWidget menuWidget)

#else
-- | Insert a new tab to the left of the existing tabs.
--
-- Like 'notebookPrependPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * This function returns @Int@ in Gtk version 2.4.0 and later
--
notebookPrependPageMenu :: (NotebookClass nb, WidgetClass child,
   WidgetClass tab, WidgetClass menu) => nb
  -> child  -- ^ Widget to use as the contents of the page
  -> tab    -- ^ Tab label widget for the page.
  -> menu   -- ^ Menu entry for this tab (usually a 'Label' widget).
  -> IO ()
notebookPrependPageMenu nb child tabWidget menuWidget =
  {#call notebook_prepend_page_menu#} (toNotebook nb) (toWidget child)
    (toWidget tabWidget) (toWidget menuWidget)
#endif

#if GTK_CHECK_VERSION(2,4,0)
-- | Insert a new tab at the specified position. That is between @pos@ and
-- @pos@+1, or -1 to append the page after all other pages.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context menu is enabled, this name will also appear in the popup menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookInsertPageMenu'.
--
-- * Returns index (starting from 0) of the inserted page in the notebook, or -1
-- if the function fails.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookInsertPage :: (NotebookClass nb, WidgetClass child) => nb
                   -> child  -- ^ Widget to use as the contents of the page
                   -> String -- ^ Label for the page.
                   -> Int    -- ^ Position for the new page.
                   -> IO Int
notebookInsertPage nb child tabLabel pos = do
  tab <- labelNew (Just tabLabel)
  liftM fromIntegral $
    {#call notebook_insert_page#} (toNotebook nb) (toWidget child) 
      (toWidget tab) (fromIntegral pos)

#else
-- | Insert a new tab at the specified position. That is between @pos@ and
-- @pos@+1, or -1 to append the page after all other pages.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context menu is enabled, this name will also appear in the popup menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookInsertPageMenu'.
--
-- * This function returns @Int@ in Gtk version 2.4.0 and later.
--
notebookInsertPage :: (NotebookClass nb, WidgetClass child) => nb
                   -> child  -- ^ Widget to use as the contents of the page
                   -> String -- ^ Label for the page.
                   -> Int    -- ^ Position for the new page.
                   -> IO ()
notebookInsertPage nb child tabLabel pos = do
  tab <- labelNew (Just tabLabel)
  {#call notebook_insert_page#} (toNotebook nb) (toWidget child) 
    (toWidget tab) (fromIntegral pos)
#endif

#if GTK_CHECK_VERSION(2,4,0)
-- | Insert a new tab at the specified position. That is between @pos@ and
-- @pos@+1, or -1 to append the page after all other pages.
--
-- Like 'notebookInsertPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * Returns the index (starting from 0) of the inserted page in the notebook,
-- or -1 if the function fails.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookInsertPageMenu ::(NotebookClass nb, WidgetClass child, 
   WidgetClass tab, WidgetClass menu) => nb
  -> child  -- ^ Widget to use as the contents of the page
  -> tab    -- ^ Tab label widget for the page.
  -> menu   -- ^ Menu entry for this tab (usually a 'Label' widget).
  -> Int    -- ^ Position for the new page.
  -> IO Int
notebookInsertPageMenu nb child tabWidget menuWidget pos = liftM fromIntegral $
  {#call notebook_insert_page_menu#} (toNotebook nb) (toWidget child)
    (toWidget tabWidget) (toWidget menuWidget) (fromIntegral pos)

#else
-- | Insert a new tab at the specified position. That is between @pos@ and
-- @pos@+1, or -1 to append the page after all other pages.
--
-- Like 'notebookInsertPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * This function returns @Int@ in Gtk version 2.4.0 and later
--
notebookInsertPageMenu ::(NotebookClass nb, WidgetClass child, 
   WidgetClass tab, WidgetClass menu) => nb
  -> child  -- ^ Widget to use as the contents of the page
  -> tab    -- ^ Tab label widget for the page.
  -> menu   -- ^ Menu entry for this tab (usually a 'Label' widget).
  -> Int    -- ^ Position for the new page.
  -> IO ()
notebookInsertPageMenu nb child tabWidget menuWidget pos =
  {#call notebook_insert_page_menu#} (toNotebook nb) (toWidget child)
    (toWidget tabWidget) (toWidget menuWidget) (fromIntegral pos)
#endif

-- | Remove a specific page from the notebook, counting from 0.
--
notebookRemovePage :: NotebookClass nb => nb -> Int -> IO ()
notebookRemovePage nb pos = 
  {#call notebook_remove_page#} (toNotebook nb) (fromIntegral pos)

-- | Query the page the child widget is contained in.
--
-- * The function returns the page number if the child was found, Nothing
--   otherwise.
--
notebookPageNum :: (NotebookClass nb, WidgetClass w) => nb -> w ->
                   IO (Maybe Int)
notebookPageNum nb child = 
  liftM (\page -> if page==(-1) then Nothing else Just (fromIntegral page)) $
  {#call unsafe notebook_page_num#} (toNotebook nb) (toWidget child)

-- | Move to the specified page of the notebook.
--
-- * If the position is out of range (e.g. negative) select the last page.
--
notebookSetCurrentPage :: NotebookClass nb => nb -> Int -> IO ()
notebookSetCurrentPage nb pos =
  {#call notebook_set_current_page#} (toNotebook nb) (fromIntegral pos)

-- | Move to the right neighbour of the current page.
--
-- * Nothing happens if there is no such page.
--
notebookNextPage :: NotebookClass nb => nb -> IO ()
notebookNextPage nb = {#call notebook_next_page#} (toNotebook nb)

-- | Move to the left neighbour of the current page.
--
-- * Nothing happens if there is no such page.
--
notebookPrevPage :: NotebookClass nb => nb -> IO ()
notebookPrevPage nb = {#call notebook_prev_page#} (toNotebook nb)

-- | Move a page withing the notebook.
--
notebookReorderChild :: (NotebookClass nb, WidgetClass w) => nb -> w -> Int ->
                        IO ()
notebookReorderChild nb child pos = {#call notebook_reorder_child#}
  (toNotebook nb) (toWidget child) (fromIntegral pos)

-- | Specify at which border the tabs should be drawn.
--
notebookSetTabPos :: NotebookClass nb => nb -> PositionType -> IO ()
notebookSetTabPos nb pt = {#call notebook_set_tab_pos#}
  (toNotebook nb) ((fromIntegral.fromEnum) pt)

-- | Gets the edge at which the tabs for switching pages in the notebook are
-- drawn.
--
notebookGetTabPos :: NotebookClass nb => nb -> IO PositionType
notebookGetTabPos nb = liftM (toEnum.fromIntegral) $
  {#call unsafe notebook_get_tab_pos#} (toNotebook nb)

-- | Show or hide the tabs of a notebook.
--
notebookSetShowTabs :: NotebookClass nb => nb -> Bool -> IO ()
notebookSetShowTabs nb showTabs = {#call notebook_set_show_tabs#}
  (toNotebook nb) (fromBool showTabs)

-- | Returns whether the tabs of the notebook are shown.
--
notebookGetShowTabs :: NotebookClass nb => nb -> IO Bool
notebookGetShowTabs nb =
  liftM toBool $ {#call unsafe notebook_get_show_tabs#} (toNotebook nb)

-- | In case the tabs are not shown, specify whether to draw a border around
-- the notebook.
--
notebookSetShowBorder :: NotebookClass nb => nb -> Bool -> IO ()
notebookSetShowBorder nb showBorder = {#call notebook_set_show_border#}
  (toNotebook nb) (fromBool showBorder)

-- | Returns whether a bevel will be drawn around the notebook pages.
--
notebookGetShowBorder :: NotebookClass nb => nb -> IO Bool
notebookGetShowBorder nb =
  liftM toBool $ {#call unsafe notebook_get_show_border#} (toNotebook nb)

-- | Set whether scroll bars will be added in case the notebook has too many
-- tabs to fit the widget size.
--
notebookSetScrollable :: NotebookClass nb => nb -> Bool -> IO ()
notebookSetScrollable nb scrollable = {#call unsafe notebook_set_scrollable#}
  (toNotebook nb) (fromBool scrollable)

-- | Returns whether the tab label area has arrows for scrolling.
--
notebookGetScrollable :: NotebookClass nb => nb -> IO Bool
notebookGetScrollable nb = liftM toBool $
  {#call unsafe notebook_get_scrollable#} (toNotebook nb)

#ifndef DISABLE_DEPRECATED
-- | Set the width of the borders of the tab labels.
--
-- * Sets both vertical and horizontal widths.
--
notebookSetTabBorder :: NotebookClass nb => nb -> Int -> IO ()
notebookSetTabBorder nb width = {#call notebook_set_tab_border#}
  (toNotebook nb) (fromIntegral width)

-- | Set the width of the borders of the tab labels.
--
-- * Sets horizontal widths.
--
notebookSetTabHBorder :: NotebookClass nb => nb -> Int -> IO ()
notebookSetTabHBorder nb width = {#call notebook_set_tab_hborder#}
  (toNotebook nb) (fromIntegral width)

-- | Set the width of the borders of the tab labels.
--
-- * Sets vertical widths.
--
notebookSetTabVBorder :: NotebookClass nb => nb -> Int -> IO ()
notebookSetTabVBorder nb width = {#call notebook_set_tab_vborder#}
  (toNotebook nb) (fromIntegral width)
#endif

-- | Enable or disable context menus with all tabs in it.
--
notebookSetPopup :: NotebookClass nb => nb -> Bool -> IO ()
notebookSetPopup nb enable = (if enable 
  then {#call notebook_popup_enable#} else {#call notebook_popup_disable#})
  (toNotebook nb)

-- | Query the currently selected page.
--
-- * Returns -1 if notebook has no pages.
--
notebookGetCurrentPage :: NotebookClass nb => nb -> IO Int
notebookGetCurrentPage nb = liftM fromIntegral $
  {#call unsafe notebook_get_current_page#} (toNotebook nb)

-- | Changes the menu label for the page containing the given child widget.
--
notebookSetMenuLabel :: (NotebookClass nb, WidgetClass ch, WidgetClass label)
                     => nb -> ch -> Maybe label -> IO ()
notebookSetMenuLabel nb child label =
  {#call notebook_set_menu_label#} (toNotebook nb) (toWidget child)
    (maybe (Widget nullForeignPtr) toWidget label)

-- | Extract the menu label from the given @child@.
--
-- * Returns Nothing if @child@ was not found.
--
notebookGetMenuLabel :: (NotebookClass nb, WidgetClass w) => nb -> w ->
                        IO (Maybe Label)
notebookGetMenuLabel nb child = do
  wPtr <- {#call unsafe notebook_get_menu_label#} 
    (toNotebook nb) (toWidget child)
  if wPtr==nullPtr then return Nothing else liftM Just $
    makeNewObject mkLabel $ return $ castPtr wPtr

-- | Creates a new label and sets it as the menu label of the given child
-- widget.
--
notebookSetMenuLabelText :: (NotebookClass nb, WidgetClass ch)
                         => nb -> ch -> String -> IO ()
notebookSetMenuLabelText nb child label =
  withUTFString label $ \labelPtr ->
  {#call notebook_set_menu_label_text#} (toNotebook nb)
    (toWidget child) labelPtr

-- | Retrieves the text of the menu label for the page containing the given
-- child widget.
--
notebookGetMenuLabelText :: (NotebookClass nb, WidgetClass ch)
                         => nb -> ch -> IO (Maybe String)
notebookGetMenuLabelText nb child = do
  labelPtr <- {#call unsafe notebook_get_menu_label_text#} (toNotebook nb)
    (toWidget child)
  maybePeek peekUTFString labelPtr

-- | Retrieve the child widget at the given position (starting from 0).
--
-- * Returns Nothing if the index is out of bounds.
--
notebookGetNthPage :: NotebookClass nb => nb -> Int -> IO (Maybe Widget)
notebookGetNthPage nb pos = do
  wPtr <- {#call unsafe notebook_get_nth_page#} 
    (toNotebook nb) (fromIntegral pos)
  if wPtr==nullPtr then return Nothing else liftM Just $
    makeNewObject mkWidget $ return wPtr

#if GTK_CHECK_VERSION(2,2,0)

-- | Get the number of pages in a notebook.
--
-- * Only available in Gtk 2.2 and higher.
--
notebookGetNPages :: NotebookClass nb => nb -> IO Int
notebookGetNPages nb = liftM fromIntegral $
  {#call unsafe notebook_get_n_pages#} (toNotebook nb)

#endif

-- | Extract the tab label from the given @child@.
--
-- * Nothing is returned if no tab label has specifically been set for the
-- child.
--
notebookGetTabLabel :: (NotebookClass nb, WidgetClass w) => nb -> w ->
                       IO (Maybe Widget)
notebookGetTabLabel nb child = do
  wPtr <- {#call unsafe notebook_get_tab_label#} 
    (toNotebook nb) (toWidget child)
  if wPtr==nullPtr then return Nothing else liftM Just $
    makeNewObject mkWidget $ return wPtr

-- | Retrieves the text of the tab label for the page containing the given child
-- widget.
--
notebookGetTabLabelText :: (NotebookClass nb, WidgetClass w) => nb -> w ->
                       IO (Maybe String)
notebookGetTabLabelText nb child = do
  labelPtr <- {#call unsafe notebook_get_tab_label_text#} (toNotebook nb)
    (toWidget child)
  maybePeek peekUTFString labelPtr

-- | Query the packing attributes of the given child.
--
notebookQueryTabLabelPacking :: (NotebookClass nb, WidgetClass w) => nb -> w ->
                                IO (Packing,PackType)
notebookQueryTabLabelPacking nb child = 
  alloca $ \expPtr -> alloca $ \fillPtr -> alloca $ \packPtr -> do
    {#call unsafe notebook_query_tab_label_packing#} (toNotebook nb)
      (toWidget child) expPtr fillPtr packPtr
    expand <- liftM toBool $ peek expPtr
    fill <- liftM toBool $ peek fillPtr
    pt <- liftM (toEnum.fromIntegral) $ peek packPtr
    return (if fill then PackGrow else 
             (if expand then PackRepel else PackNatural),
	    pt)

-- | Set the packing attributes of the given child.
--
notebookSetTabLabelPacking :: (NotebookClass nb, WidgetClass w) => nb -> w ->
                              Packing -> PackType -> IO ()
notebookSetTabLabelPacking nb child pack pt = 
  {#call notebook_set_tab_label_packing#} (toNotebook nb) (toWidget child)
    (fromBool $ pack/=PackNatural) (fromBool $ pack==PackGrow) 
    ((fromIntegral.fromEnum) pt)

#ifndef DISABLE_DEPRECATED
-- | Sets whether the tabs must have all the same size or not.
--
notebookSetHomogeneousTabs :: NotebookClass nb => nb -> Bool -> IO ()
notebookSetHomogeneousTabs nb hom = {#call notebook_set_homogeneous_tabs#}
  (toNotebook nb) (fromBool hom)
#endif

-- | Set a new tab label for a given page.
--
notebookSetTabLabel :: (NotebookClass nb, WidgetClass ch, WidgetClass tab) => 
                       nb -> ch -> tab -> IO ()
notebookSetTabLabel nb child tab = {#call notebook_set_tab_label#}
  (toNotebook nb) (toWidget child) (toWidget tab)

-- | Creates a new label and sets it as the tab label for the given page.
--
notebookSetTabLabelText :: (NotebookClass nb, WidgetClass ch) => 
                       nb -> ch -> String -> IO ()
notebookSetTabLabelText nb child label =
  withUTFString label $ \labelPtr ->
  {#call notebook_set_tab_label_text#} (toNotebook nb) (toWidget child) labelPtr


-- signals

-- | This signal is emitted when a new page is
-- selected.
--
onSwitchPage, afterSwitchPage :: NotebookClass nb => nb -> (Int -> IO ()) ->
                                 IO (ConnectId nb)
onSwitchPage nb fun = connect_BOXED_WORD__NONE "switch-page" 
		      (const $ return ()) False nb 
		      (\_ page -> fun (fromIntegral page))
afterSwitchPage nb fun = connect_BOXED_WORD__NONE "switch-page" 
			 (const $ return ()) True nb 
			 (\_ page -> fun (fromIntegral page))


 

--- Alignment.chs DELETED ---

--- Expander.chs DELETED ---

--- Notebook.chs DELETED ---

--- NEW FILE: Expander.chspp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Expander
--
--  Author : Duncan Coutts
--  Created: 24 April 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- An Expander allows the user to hide or show its child by clicking on an
-- expander triangle similar to the triangles used in a TreeView.
--
-- Normally you use an expander as you would use any other descendant of GtkBin
-- you create the child widget and use containerAdd to add it to the expander.
-- When the expander is toggled, it will take care of showing and hiding the
-- child automatically.
--
-- * Added in GTK+ 2.4
--
module Expander (
#if GTK_CHECK_VERSION(2,4,0)
  Expander,
  ExpanderClass,
  expanderNew,
  expanderNewWithMnemonic,
  expanderSetExpanded,
  expanderGetExpanded,
  expanderSetSpacing,
  expanderGetSpacing,
  expanderSetLabel,
  expanderGetLabel,
  expanderSetUseUnderline,
  expanderGetUseUnderline,
  expanderSetUseMarkup,
  expanderGetUseMarkup,
  expanderSetLabelWidget,
  expanderGetLabelWidget,
  onActivate,
  afterActivate
#endif
) where

#if GTK_CHECK_VERSION(2,4,0)

import Monad (liftM)
import FFI
import Object
{#import Hierarchy#}
import Signal

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

expanderNew :: String -> IO Expander
expanderNew label = 
 makeNewObject mkExpander $ liftM castPtr $
 withUTFString label $ \strPtr ->
 {# call gtk_expander_new #} strPtr

expanderNewWithMnemonic :: String -> IO Expander
expanderNewWithMnemonic label =
 makeNewObject mkExpander $ liftM castPtr $
 withUTFString label $ \strPtr -> 
 {# call gtk_expander_new_with_mnemonic #} strPtr

expanderSetExpanded :: Expander -> Bool -> IO ()
expanderSetExpanded expander expanded = 
 {# call gtk_expander_set_expanded #} expander (fromBool expanded)

expanderGetExpanded :: Expander -> IO Bool
expanderGetExpanded expander = liftM toBool $
 {# call gtk_expander_get_expanded #} expander

expanderSetSpacing :: Expander -> Int -> IO ()
expanderSetSpacing expander spacing = 
 {# call gtk_expander_set_spacing #} expander (fromIntegral spacing)

expanderGetSpacing :: Expander -> IO Int
expanderGetSpacing expander = liftM fromIntegral $
 {# call gtk_expander_get_spacing #} expander

expanderSetLabel :: Expander -> String -> IO ()
expanderSetLabel expander label =
 withUTFString label $ \strPtr ->
 {# call gtk_expander_set_label #} expander strPtr

expanderGetLabel :: Expander -> IO String
expanderGetLabel expander = do
 strPtr <- {# call gtk_expander_get_label #} expander
 peekUTFString strPtr

expanderSetUseUnderline :: Expander -> Bool -> IO ()
expanderSetUseUnderline expander useUnderline = 
 {# call gtk_expander_set_use_underline #} expander (fromBool useUnderline)

expanderGetUseUnderline :: Expander -> IO Bool
expanderGetUseUnderline expander = liftM toBool $
 {# call gtk_expander_get_use_underline #} expander

expanderSetUseMarkup :: Expander -> Bool -> IO ()
expanderSetUseMarkup expander useMarkup = 
 {# call gtk_expander_set_use_markup #} expander (fromBool useMarkup)

expanderGetUseMarkup :: Expander -> IO Bool
expanderGetUseMarkup expander = liftM toBool $
 {# call gtk_expander_get_use_markup #} expander

expanderSetLabelWidget :: WidgetClass widget => Expander -> widget -> IO ()
expanderSetLabelWidget expander widget = 
 {# call gtk_expander_set_label_widget #} expander (toWidget widget)

expanderGetLabelWidget :: Expander -> IO Widget
expanderGetLabelWidget expander = 
 makeNewObject mkWidget $
 {# call gtk_expander_get_label_widget #} expander

onActivate :: Expander -> IO () -> IO (ConnectId Expander)
afterActivate :: Expander -> IO () -> IO (ConnectId Expander)
onActivate = connect_NONE__NONE "activate" False
afterActivate = connect_NONE__NONE "activate" True

#endif

--- NEW FILE: Alignment.chspp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Alignment
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/24 17:19:22 $
--
--  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.
--
-- |
--
module Alignment(
  Alignment,
  AlignmentClass,
  castToAlignment,
  alignmentNew,
  alignmentSet
#if GTK_CHECK_VERSION(2,4,0)
 ,alignmentSetPadding,
  alignmentGetPadding
#endif
  ) where

import Monad	(liftM)
import FFI

import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}

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

-- methods

-- | Create an alignment widget. This widget tells
-- its child widget how to use the given space.
--
alignmentNew :: Float -> Float -> Float -> Float -> IO Alignment
alignmentNew yscale xalign yalign xscale = makeNewObject mkAlignment $
  liftM castPtr $ {#call unsafe alignment_new#} (realToFrac xalign) 
  (realToFrac yalign) (realToFrac xscale) (realToFrac yscale)


-- | Change the space use behaviour of an 'Alignment'.
--
alignmentSet :: AlignmentClass al => al -> Float -> Float -> Float -> Float ->
                IO ()
alignmentSet al xalign yalign xscale yscale = {#call alignment_set#}
  (toAlignment al) (realToFrac xalign) (realToFrac yalign)
  (realToFrac xscale) (realToFrac yscale)

#if GTK_CHECK_VERSION(2,4,0)
-- | Sets the padding on the different sides of the widget.
--
alignmentSetPadding :: AlignmentClass al => al -> Int -> Int -> Int -> Int ->
                       IO ()
alignmentSetPadding al top bottom left right =
  {# call gtk_alignment_set_padding #} (toAlignment al)
    (fromIntegral top) (fromIntegral bottom)
    (fromIntegral left) (fromIntegral right)

-- | Gets the padding on the different sides of the widget.
--
alignmentGetPadding :: AlignmentClass al => al -> IO (Int, Int, Int, Int)
alignmentGetPadding al =
  alloca $ \topPtr -> alloca $ \bottomPtr ->
  alloca $ \leftPtr -> alloca $ \rightPtr -> do
  {# call gtk_alignment_get_padding #} (toAlignment al)
    topPtr bottomPtr leftPtr rightPtr
  top    <- peek topPtr
  bottom <- peek bottomPtr
  left   <- peek leftPtr
  right  <- peek rightPtr
  return (fromIntegral top, fromIntegral bottom
         ,fromIntegral left, fromIntegral right)
  
#endif

[Gtk2hs-commit] gtk2hs/gtk/abstract ButtonBox.chspp,NONE,1.1 FileChooser.chspp,NONE,1.1 Object.chspp,NONE,1.1 Paned.chspp,NONE,1.1 ButtonBox.chs,1.4,NONE FileChooser.chs,1.9,NONE Object.chs,1.10,NONE Paned.chs,1.6,NONE

[Axel S. <as...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/abstract
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28086/gtk/abstract

Added Files:
	ButtonBox.chspp FileChooser.chspp Object.chspp Paned.chspp 
Removed Files:
	ButtonBox.chs FileChooser.chs Object.chs Paned.chs 
Log Message:
New build system.


--- Paned.chs DELETED ---

--- NEW FILE: Paned.chspp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Paned
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/24 17:19:19 $
--
--  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.
--
-- |
--
-- This abstract widget provides a division line with a handle that can be
-- used by the user to divide the given space between two widgets. The two
-- concrete implementations are HPaned and VPaned.
--
module Paned(
  Paned,
  PanedClass,
  castToPaned,
  panedAdd1,
  panedAdd2,
  panedPack1,
  panedPack2,
  panedSetPosition,
  panedGetPosition
#if GTK_CHECK_VERSION(2,4,0)
 ,panedGetChild1,
  panedGetChild2
#endif
  ) where

import Monad	(liftM)
import FFI

import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}

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

-- methods

-- | Add a widget to the first (top or left) area.
--
-- * The widget does not expand if 'Paned' expands. It does not shrink either.
--
panedAdd1 :: (PanedClass p, WidgetClass w) => p -> w -> IO ()
panedAdd1 p w = {#call paned_add1#} (toPaned p) (toWidget w)

-- | Add a widget to the second (bottom or right) area.
--
-- * The widget does not expand if 'Paned' expands. But it does shrink.
--
panedAdd2 :: (PanedClass p, WidgetClass w) => p -> w -> IO ()
panedAdd2 p w = {#call paned_add2#} (toPaned p) (toWidget w)

-- | Add a widget to the first area and specify its resizing behaviour.
--
panedPack1 :: (PanedClass p, WidgetClass w) => p -> w -> Bool -> Bool -> IO ()
panedPack1 p w expand shrink = {#call paned_pack1#} 
  (toPaned p) (toWidget w) (fromBool expand) (fromBool shrink)

-- | Add a widget to the second area and specify its resizing behaviour.
--
panedPack2 :: (PanedClass p, WidgetClass w) => p -> w -> Bool -> Bool -> IO ()
panedPack2 p w expand shrink = {#call paned_pack2#} 
  (toPaned p) (toWidget w) (fromBool expand) (fromBool shrink)

-- | Set the gutter to the specified @position@ (in pixels).
--
panedSetPosition :: PanedClass p => p -> Int -> IO ()
panedSetPosition p position = 
  {#call paned_set_position#} (toPaned p) (fromIntegral position)

-- | Get the gutter position (in pixels).
--
panedGetPosition :: PanedClass p => p -> IO Int
panedGetPosition p = liftM fromIntegral $
  {#call unsafe paned_get_position#} (toPaned p)

#if GTK_CHECK_VERSION(2,4,0)
-- | Obtains the first child of the paned widget.
--
panedGetChild1 :: PanedClass p => p -> IO Widget
panedGetChild1 p =
  makeNewObject mkWidget $ {#call unsafe paned_get_child1#} (toPaned p)

-- | Obtains the second child of the paned widget.
--
panedGetChild2 :: PanedClass p => p -> IO Widget
panedGetChild2 p =
  makeNewObject mkWidget $ {#call unsafe paned_get_child2#} (toPaned p)
#endif

--- NEW FILE: ButtonBox.chspp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget ButtonBox
--
--  Author : Matthew Walton
--          
--  Created: 28 April 2004
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/24 17:19:19 $
--
--  Copyright (c) 2004 Matthew Walton
--
--  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.
--
-- |
--
module ButtonBox(
  ButtonBox,
  ButtonBoxClass,
  castToButtonBox,
  buttonBoxGetLayout,
  buttonBoxSetLayout,
  buttonBoxSetChildSecondary,
#if GTK_CHECK_VERSION(2,4,0)
  buttonBoxGetChildSecondary
#endif
  ) where

import Monad (liftM)
import FFI

import Object (makeNewObject)
{#import Hierarchy#}
{#import Signal#}

import Enums (ButtonBoxStyle)

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

-- methods

-- | Retrieve the method being used to
-- arrange the buttons in the button box
--
buttonBoxGetLayout :: ButtonBoxClass b => b -> IO ButtonBoxStyle
buttonBoxGetLayout b = liftM (toEnum . fromIntegral) $
  {#call gtk_button_box_get_layout#} (toButtonBox b)

#if GTK_CHECK_VERSION(2,4,0)
-- | Returns whether child should appear
-- in a secondary group of children
--
-- * Since Gtk 2.4.
buttonBoxGetChildSecondary :: (ButtonBoxClass b, WidgetClass w) => b -> w -> IO Bool
buttonBoxGetChildSecondary b w = liftM toBool $
  {#call gtk_button_box_get_child_secondary#} (toButtonBox b) (toWidget w)
#endif

-- | Changes the way buttons are arranged in their container
--
buttonBoxSetLayout :: ButtonBoxClass b => b -> ButtonBoxStyle -> IO ()
buttonBoxSetLayout b l =
  {#call gtk_button_box_set_layout#} (toButtonBox b)
    ((fromIntegral . fromEnum) l)

-- | Sets whether child should appear in a secondary
-- group of children. A typical use of a secondary child is the help button in a dialog.
--
-- * This group appears after the other children if the style is 'ButtonboxStart',
-- 'ButtonboxSpread' or 'ButtonboxEdge', and before the the other children if the
-- style is 'ButtonboxEnd'. For horizontal button boxes, the definition of before\/after
-- depends on direction of the widget (see 'widgetSetDirection'). If the style is
-- 'buttonBoxStart' or 'buttonBoxEnd', then the secondary children are aligned at
-- the other end of the button box from the main children. For the other styles,
-- they appear immediately next to the main children.
--
buttonBoxSetChildSecondary :: (ButtonBoxClass b, WidgetClass w) => b -> w -> Bool -> IO ()
buttonBoxSetChildSecondary b w s =
  {#call gtk_button_box_set_child_secondary #} (toButtonBox b) (toWidget w)
    (fromBool s)

--- NEW FILE: Object.chspp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Object
--
--  Author : Axel Simon
--          
--  Created: 9 April 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/24 17:19:19 $
--
--  Copyright (c) 2001 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.
--
-- |
--
-- Widget representation
--
-- * Each widget is a represented as a purely abstract data type. It can only 
--   be accessed through and the special access functions that are defined
--   in each widget file.
--
module Object(
  Object,
  ObjectClass,
  castToObject,
  objectSink,
  makeNewObject,
  objectSetProperty,
  objectGetProperty
  ) where

import FFI

import GObject		(objectRef, objectUnref)
{#import Signal#}
{#import Hierarchy#}
{#import GValue#}
import StoreValue

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

-- methods

-- turn the initial floating state to sunk
--
-- * The floating\/sunk concept of a GTK object is not very useful to us.
--   The following procedure circumvents the whole subject and ensures 
--   proper cleanup:
--     on creation:      objectRef, objectSink
--     on finalization:  objectUnref
--
-- * This function cannot be bound by c2hs because it is not possible to
--   override the pointer hook.
objectSink :: ObjectClass obj => Ptr obj -> IO ()
objectSink = object_sink.castPtr

#if __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gtk_object_sink"
  object_sink :: Ptr Object -> IO ()

#else

foreign import ccall "gtk_object_sink" unsafe 
  object_sink :: Ptr Object -> IO ()

#endif

-- This is a convenience function to generate a new widget. It adds the
-- finalizer with the method described under objectSink.
--
-- * The constr argument is the contructor of the specific object.
--
makeNewObject :: ObjectClass obj => 
  (ForeignPtr obj -> obj) -> IO (Ptr obj) -> IO obj
makeNewObject constr generator = do
  objPtr <- generator
  objectRef objPtr
  obj <- newForeignPtr objPtr (objectUnref objPtr)
  objectSink objPtr
  return $ constr obj


-- Sets a specific attribute of this object.
--
-- * Most attributes in a widget can be set and retrieved by passing the
--   name (as a string) and the value to special set\/get functions. These
--   are undocumented because each derived objects implements custom (and
--   welltyped) set and get functions for most attributes.
--
objectSetProperty :: GObjectClass gobj => gobj -> String -> GenericValue -> 
					  IO ()
objectSetProperty obj prop val = alloca $ \vaPtr -> withUTFString prop $ 
  \sPtr -> poke vaPtr val >> {#call unsafe g_object_set_property#} 
  (toGObject obj) sPtr vaPtr >> valueUnset vaPtr
  

-- Gets a specific attribute of this object.
--
-- * See 'objectSetProperty'.
--
objectGetProperty :: GObjectClass gobj => gobj -> String -> 
					IO GenericValue
objectGetProperty obj prop = alloca $ \vaPtr -> withUTFString prop $ \str -> do
  {#call unsafe g_object_get_property#} (toGObject obj) str vaPtr
  res <- peek vaPtr
  valueUnset vaPtr
  return res


--- ButtonBox.chs DELETED ---

--- Object.chs DELETED ---

--- NEW FILE: FileChooser.chspp ---
-- GIMP Toolkit (GTK) Binding for Haskell: binding to GConf   -*-haskell-*-
--    for storing and retrieving configuartion information
--
--  Author : Duncan Coutts
--  Created: 24 April 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
--  The file chooser dialog and widget is a replacement
--  for the old "FileSel"ection dialog. It provides a better user
--  interface and an improved API.
--
--  The FileChooser (as opposed to the dialog or widget) is the interface that
--  the "FileChooserDialog" and "FileChooserWidget" implement, all the operations
--  except construction are on this interface.
--
-- * Added in GTK+ 2.4
--
module FileChooser (
#if GTK_CHECK_VERSION(2,4,0)
  FileChooserClass,
  FileChooser,
  FileChooserAction(..),
  fileChooserSetAction,
  fileChooserGetAction,
  fileChooserSetLocalOnly,
  fileChooserGetLocalOnly,
  fileChooserSetSelectMultiple,
  fileChooserGetSelectMultiple,
  fileChooserSetCurrentName,
  fileChooserGetFilename,
  fileChooserSetFilename,
  fileChooserSelectFilename,
  fileChooserUnselectFilename,
  fileChooserSelectAll,
  fileChooserUnselectAll,
  fileChooserGetFilenames,
  fileChooserSetCurrentFolder,
  fileChooserGetCurrentFolder,
  fileChooserGetURI,
  fileChooserSetURI,
  fileChooserSelectURI,
  fileChooserUnselectURI,
  fileChooserGetURIs,
  fileChooserSetCurrentFolderURI,
  fileChooserGetCurrentFolderURI,
  fileChooserSetPreviewWidget,
  fileChooserGetPreviewWidget,
  fileChooserSetPreviewWidgetActive,
  fileChooserGetPreviewWidgetActive,
  fileChooserSetUsePreviewLabel,
  fileChooserGetUsePreviewLabel,
  fileChooserGetPreviewFilename,
  fileChooserGetPreviewURI,
  fileChooserSetExtraWidget,
  fileChooserGetExtraWidget,
  fileChooserAddFilter,
  fileChooserRemoveFilter,
  fileChooserListFilters,
  fileChooserSetFilter,
  fileChooserGetFilter,
  fileChooserAddShortcutFolder,
  fileChooserRemoveShortcutFolder,
  fileChooserlistShortcutFolders,
  fileChooserAddShortcutFolderURI,
  fileChooserRemoveShortcutFolderURI,
  fileChooserListShortcutFolderURIs,
  onCurrentFolderChanged,
  afterCurrentFolderChanged,
  onFileActivated,
  afterFileActivated,
--  onSelectionChanged,
--  afterSelectionChanged,
  onUpdatePreview,
  afterUpdatePreview
#endif
) where

#if GTK_CHECK_VERSION(2,4,0)

import Monad (liftM, when)
import FFI
{#import Hierarchy#}
import Object		(makeNewObject)
import Signal
{#import GList#}
import GError (propagateGError, GErrorDomain, GErrorClass(..))

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

{# enum FileChooserAction {underscoreToCase} #}
{# enum FileChooserError {underscoreToCase} #}

fileChooserErrorDomain :: GErrorDomain
fileChooserErrorDomain = unsafePerformIO {#call unsafe file_chooser_error_quark#}
                                                                                                         
instance GErrorClass FileChooserError where
  gerrorDomain _ = fileChooserErrorDomain

fileChooserSetAction :: FileChooserClass chooser => chooser -> FileChooserAction -> IO ()
fileChooserSetAction chooser action =
  {# call gtk_file_chooser_set_action #} (toFileChooser chooser)
    (fromIntegral $ fromEnum action)

fileChooserGetAction :: FileChooserClass chooser => chooser ->  IO FileChooserAction
fileChooserGetAction chooser = liftM (toEnum . fromIntegral) $
  {# call gtk_file_chooser_get_action #} (toFileChooser chooser)

fileChooserSetLocalOnly :: FileChooserClass chooser => chooser -> Bool -> IO ()
fileChooserSetLocalOnly chooser localOnly = 
  {# call gtk_file_chooser_set_local_only #} (toFileChooser chooser)
    (fromBool localOnly)

fileChooserGetLocalOnly :: FileChooserClass chooser => chooser -> IO Bool
fileChooserGetLocalOnly chooser = liftM toBool $
  {# call gtk_file_chooser_get_local_only #} (toFileChooser chooser)

fileChooserSetSelectMultiple :: FileChooserClass chooser => chooser -> Bool -> IO ()
fileChooserSetSelectMultiple chooser selectMultiple = 
  {# call gtk_file_chooser_set_select_multiple #} (toFileChooser chooser)
    (fromBool selectMultiple)

fileChooserGetSelectMultiple :: FileChooserClass chooser => chooser -> IO Bool
fileChooserGetSelectMultiple chooser = liftM toBool $
  {# call gtk_file_chooser_get_select_multiple #} (toFileChooser chooser)

fileChooserSetCurrentName :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserSetCurrentName chooser name =
  withCString name $ \strPtr ->
  {# call gtk_file_chooser_set_current_name #} (toFileChooser chooser) strPtr

fileChooserGetFilename :: FileChooserClass chooser => chooser -> IO (Maybe String)
fileChooserGetFilename chooser = do
  strPtr <- {# call gtk_file_chooser_get_filename #} (toFileChooser chooser)
  maybePeek readCString strPtr

fileChooserSetFilename :: FileChooserClass chooser => chooser -> String -> IO Bool
fileChooserSetFilename chooser filename = liftM toBool $
  withCString filename $ \strPtr ->
  {# call gtk_file_chooser_set_filename #} (toFileChooser chooser) strPtr

fileChooserSelectFilename :: FileChooserClass chooser => chooser -> String -> IO Bool
fileChooserSelectFilename chooser filename = liftM toBool $
  withCString filename $ \strPtr ->
  {# call gtk_file_chooser_select_filename #} (toFileChooser chooser) strPtr

fileChooserUnselectFilename :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserUnselectFilename chooser filename = 
  withCString filename $ \strPtr ->
  {# call gtk_file_chooser_unselect_filename #} (toFileChooser chooser) strPtr

fileChooserSelectAll :: FileChooserClass chooser => chooser -> IO ()
fileChooserSelectAll chooser = 
  {# call gtk_file_chooser_select_all #} (toFileChooser chooser)

fileChooserUnselectAll :: FileChooserClass chooser => chooser -> IO ()
fileChooserUnselectAll chooser = 
  {# call gtk_file_chooser_unselect_all #} (toFileChooser chooser)

fileChooserGetFilenames :: FileChooserClass chooser => chooser -> IO [String]
fileChooserGetFilenames chooser = do
  strList <- {# call gtk_file_chooser_get_filenames #} (toFileChooser chooser)
  fromStringGSList strList

fileChooserSetCurrentFolder :: FileChooserClass chooser => chooser -> String -> IO Bool
fileChooserSetCurrentFolder chooser foldername = liftM toBool $
  withCString foldername $ \strPtr ->
  {# call gtk_file_chooser_set_current_folder #} (toFileChooser chooser) strPtr

fileChooserGetCurrentFolder :: FileChooserClass chooser => chooser -> IO (Maybe String)
fileChooserGetCurrentFolder chooser = do
  strPtr <- {# call gtk_file_chooser_get_current_folder #} (toFileChooser chooser)
  maybePeek readCString strPtr

fileChooserGetURI :: FileChooserClass chooser => chooser -> IO (Maybe String)
fileChooserGetURI chooser = do
  strPtr <- {# call gtk_file_chooser_get_uri #} (toFileChooser chooser)
  maybePeek readCString strPtr

fileChooserSetURI :: FileChooserClass chooser => chooser -> String -> IO Bool
fileChooserSetURI chooser uri = liftM toBool $
  withCString uri $ \strPtr ->
  {# call gtk_file_chooser_set_uri #} (toFileChooser chooser) strPtr

fileChooserSelectURI :: FileChooserClass chooser => chooser -> String -> IO Bool
fileChooserSelectURI chooser uri = liftM toBool $
  withCString uri $ \strPtr ->
  {# call gtk_file_chooser_select_uri #} (toFileChooser chooser) strPtr

fileChooserUnselectURI :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserUnselectURI chooser uri = 
  withCString uri $ \strPtr ->
  {# call gtk_file_chooser_unselect_uri #} (toFileChooser chooser) strPtr

fileChooserGetURIs :: FileChooserClass chooser => chooser -> IO [String]
fileChooserGetURIs chooser = do
  strList <- {# call gtk_file_chooser_get_uris #} (toFileChooser chooser)
  fromStringGSList strList

fileChooserSetCurrentFolderURI :: FileChooserClass chooser => chooser -> String -> IO Bool
fileChooserSetCurrentFolderURI chooser uri = liftM toBool $
  withCString uri $ \strPtr ->
  {# call gtk_file_chooser_set_current_folder_uri #} (toFileChooser chooser) strPtr

fileChooserGetCurrentFolderURI :: FileChooserClass chooser => chooser -> IO String
fileChooserGetCurrentFolderURI chooser = do
  strPtr <- {# call gtk_file_chooser_get_current_folder_uri #} (toFileChooser chooser)
  readCString strPtr

fileChooserSetPreviewWidget :: (FileChooserClass chooser, WidgetClass widget) =>
                               chooser -> widget -> IO ()
fileChooserSetPreviewWidget chooser widget = 
  {# call gtk_file_chooser_set_preview_widget #} (toFileChooser chooser)
    (toWidget widget)

fileChooserGetPreviewWidget :: FileChooserClass chooser => chooser -> IO (Maybe Widget)
fileChooserGetPreviewWidget chooser = do
  ptr <- {# call gtk_file_chooser_get_preview_widget #} (toFileChooser chooser)
  maybePeek (makeNewObject mkWidget . return) ptr

fileChooserSetPreviewWidgetActive :: FileChooserClass chooser => chooser -> Bool -> IO ()
fileChooserSetPreviewWidgetActive chooser active = 
  {# call gtk_file_chooser_set_preview_widget_active #} (toFileChooser chooser)
    (fromBool active)

fileChooserGetPreviewWidgetActive :: FileChooserClass chooser => chooser -> IO Bool
fileChooserGetPreviewWidgetActive chooser = liftM toBool $
  {# call gtk_file_chooser_get_preview_widget_active #} (toFileChooser chooser)

fileChooserSetUsePreviewLabel :: FileChooserClass chooser => chooser -> Bool -> IO ()
fileChooserSetUsePreviewLabel chooser usePreview = 
  {# call gtk_file_chooser_set_use_preview_label #} (toFileChooser chooser)
    (fromBool usePreview)

fileChooserGetUsePreviewLabel :: FileChooserClass chooser => chooser -> IO Bool
fileChooserGetUsePreviewLabel chooser = liftM toBool $
  {# call gtk_file_chooser_get_use_preview_label #} (toFileChooser chooser)

fileChooserGetPreviewFilename :: FileChooserClass chooser => chooser -> IO (Maybe String)
fileChooserGetPreviewFilename chooser = do
  strPtr <- {# call gtk_file_chooser_get_preview_filename #} (toFileChooser chooser)
  maybePeek readCString strPtr

fileChooserGetPreviewURI :: FileChooserClass chooser => chooser -> IO (Maybe String)
fileChooserGetPreviewURI chooser = do
  strPtr <- {# call gtk_file_chooser_get_preview_uri #} (toFileChooser chooser)
  maybePeek readCString strPtr

fileChooserSetExtraWidget :: (FileChooserClass chooser, WidgetClass widget) =>
                             chooser -> widget -> IO ()
fileChooserSetExtraWidget chooser widget = 
  {# call gtk_file_chooser_set_extra_widget #} (toFileChooser chooser)
    (toWidget widget)

fileChooserGetExtraWidget :: FileChooserClass chooser => chooser -> IO (Maybe Widget)
fileChooserGetExtraWidget chooser = do
  ptr <- {# call gtk_file_chooser_get_extra_widget #} (toFileChooser chooser)
  maybePeek (makeNewObject mkWidget . return) ptr

fileChooserAddFilter :: FileChooserClass chooser => chooser -> FileFilter -> IO ()
fileChooserAddFilter chooser filter = 
  {# call gtk_file_chooser_add_filter #} (toFileChooser chooser) filter

fileChooserRemoveFilter :: FileChooserClass chooser => chooser -> FileFilter -> IO ()
fileChooserRemoveFilter chooser filter = 
  {# call gtk_file_chooser_remove_filter #} (toFileChooser chooser) filter

fileChooserListFilters :: FileChooserClass chooser => chooser -> IO [FileFilter]
fileChooserListFilters chooser = do
  filterList <- {# call gtk_file_chooser_list_filters #} (toFileChooser chooser)
  filterPtrs <- fromGSList filterList
  mapM (makeNewObject mkFileFilter . return) filterPtrs

fileChooserSetFilter :: FileChooserClass chooser => chooser -> FileFilter -> IO ()
fileChooserSetFilter chooser filter = 
  {# call gtk_file_chooser_set_filter #} (toFileChooser chooser) filter

fileChooserGetFilter :: FileChooserClass chooser => chooser -> IO (Maybe FileFilter)
fileChooserGetFilter chooser = do
  ptr <- {# call gtk_file_chooser_get_filter #} (toFileChooser chooser)
  maybePeek (makeNewObject mkFileFilter . return) ptr

fileChooserAddShortcutFolder :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserAddShortcutFolder chooser foldername =
  propagateGError $ \gerrorPtr ->
  withCString foldername $ \strPtr -> do
  {# call gtk_file_chooser_add_shortcut_folder #} (toFileChooser chooser)
    strPtr gerrorPtr
  return ()

fileChooserRemoveShortcutFolder :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserRemoveShortcutFolder chooser foldername =
  propagateGError $ \gerrorPtr ->
  withCString foldername $ \strPtr -> do
  {# call gtk_file_chooser_remove_shortcut_folder #} (toFileChooser chooser)
    strPtr gerrorPtr
  return ()

fileChooserlistShortcutFolders :: FileChooserClass chooser => chooser -> IO [String]
fileChooserlistShortcutFolders chooser = do
  strList <- {# call gtk_file_chooser_list_shortcut_folders #}
    (toFileChooser chooser)
  fromStringGSList strList

fileChooserAddShortcutFolderURI :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserAddShortcutFolderURI chooser folderuri =
  propagateGError $ \gerrorPtr ->
  withCString folderuri $ \strPtr -> do
  {# call gtk_file_chooser_add_shortcut_folder_uri #} (toFileChooser chooser)
    strPtr gerrorPtr
  return ()

fileChooserRemoveShortcutFolderURI :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserRemoveShortcutFolderURI chooser folderuri =
  propagateGError $ \gerrorPtr ->
  withCString folderuri $ \strPtr -> do
  {# call gtk_file_chooser_remove_shortcut_folder_uri #}
    (toFileChooser chooser) strPtr gerrorPtr
  return ()

fileChooserListShortcutFolderURIs :: FileChooserClass chooser => chooser -> IO [String]
fileChooserListShortcutFolderURIs chooser = do
  strList <- {# call gtk_file_chooser_list_shortcut_folder_uris #}
    (toFileChooser chooser)
  fromStringGSList strList

onCurrentFolderChanged, afterCurrentFolderChanged :: FileChooserClass c => c -> IO () -> IO (ConnectId c)
onCurrentFolderChanged = connect_NONE__NONE "current-folder-changed" False
afterCurrentFolderChanged = connect_NONE__NONE "current-folder-changed" True

onFileActivated, afterFileActivated :: FileChooserClass c => c -> IO () -> IO (ConnectId c)
onFileActivated = connect_NONE__NONE "file-activated" False
afterFileActivated = connect_NONE__NONE "file-activated" True

--onSelectionChanged, afterSelectionChanged :: FileChooserClass c => c -> IO () -> IO (ConnectId c)
--onSelectionChanged = connect_NONE__NONE "selection-changed" False
--afterSelectionChanged = connect_NONE__NONE "selection-changed" True

onUpdatePreview, afterUpdatePreview :: FileChooserClass c => c -> IO () -> IO (ConnectId c)
onUpdatePreview = connect_NONE__NONE "update-preview" False
afterUpdatePreview = connect_NONE__NONE "update-preview" True


------------------------------------------------------
-- Utility functions that really ought to go elsewhere

-- convenience functions for GSlists of strings
fromStringGSList :: GSList -> IO [String]
fromStringGSList strList = do
  strPtrs <- fromGSList strList
  mapM readCString strPtrs

toStringGSList :: [String] -> IO GSList
toStringGSList strs = do
  strPtrs <- mapM newCString strs
  toGSList strPtrs

#endif


--- FileChooser.chs DELETED ---