diff --git a/Graphics/UI/Gtk.chs b/Graphics/UI/Gtk.chs --- a/Graphics/UI/Gtk.chs +++ b/Graphics/UI/Gtk.chs @@ -492,7 +492,8 @@ GWeakNotify, objectWeakref, objectWeakunref, - objectDestroy ) + objectDestroy, + notifyProperty ) import Graphics.UI.Gtk.Abstract.Paned import Graphics.UI.Gtk.Abstract.Range import Graphics.UI.Gtk.Abstract.Scale diff --git a/Graphics/UI/Gtk/Abstract/Object.chs b/Graphics/UI/Gtk/Abstract/Object.chs --- a/Graphics/UI/Gtk/Abstract/Object.chs +++ b/Graphics/UI/Gtk/Abstract/Object.chs @@ -67,12 +67,14 @@ objectWeakunref, -- * Signals - objectDestroy + objectDestroy, + notifyProperty ) where import Control.Monad (when) import System.Glib.FFI +import System.Glib.Attributes (ReadWriteAttr) import System.Glib.GObject (objectUnref) #if GLIB_CHECK_VERSION(2,10,0) import System.Glib.GObject (objectRefSink) @@ -156,3 +158,15 @@ -- objectDestroy :: ObjectClass self => Signal self (IO ()) objectDestroy = Signal (connect_NONE__NONE "destroy") + +-- | Register a notify callback that is triggered when the given property +-- has been modified. +-- +-- * Note that this callback is triggered even if the actual value of +-- the property has not changed. +-- * Not all attributes are properties. A warning will be generated at +-- runtime if the passed-in attribute is not a property of the class +-- with which it was registered. +-- +notifyProperty :: ObjectClass self => ReadWriteAttr self a b -> Signal self (IO ()) +notifyProperty attr = Signal (\on obj cb -> connect_PTR__NONE ("notify::"++show attr) on obj (const cb)) diff --git a/Graphics/UI/Gtk/Abstract/Widget.chs b/Graphics/UI/Gtk/Abstract/Widget.chs --- a/Graphics/UI/Gtk/Abstract/Widget.chs +++ b/Graphics/UI/Gtk/Abstract/Widget.chs @@ -158,6 +158,10 @@ widgetModifyText, widgetModifyBase, widgetModifyFont, + widgetRestoreFg, + widgetRestoreBg, + widgetRestoreText, + widgetRestoreBase, widgetCreatePangoContext, widgetGetPangoContext, widgetCreateLayout, @@ -1384,8 +1388,7 @@ widgetModifyFg :: WidgetClass self => self -> StateType -- ^ @state@ - the state for which to set the foreground color. -> Color -- ^ @color@ - the color to assign (does not need to be - -- allocated), or @Nothing@ to undo the effect of previous calls - -- to of 'widgetModifyFg'. + -- allocated) -> IO () widgetModifyFg self state color = with color $ \colorPtr -> @@ -1394,6 +1397,18 @@ ((fromIntegral . fromEnum) state) (castPtr colorPtr) +-- | Restores the foreground color for a widget in a particular state. This +-- undoes the effects of previous calls to `widgetModifyFg'. +-- +widgetRestoreFg :: WidgetClass self => self + -> StateType -- ^ @state@ - the state for which to restore the foreground color. + -> IO () +widgetRestoreFg self state = + {# call gtk_widget_modify_fg #} + (toWidget self) + ((fromIntegral . fromEnum) state) + nullPtr + -- %hash c:2c5 -- | Sets the background color for a widget in a particular state. All other -- style values are left untouched. See also 'widgetModifyStyle'. @@ -1408,8 +1423,7 @@ widgetModifyBg :: WidgetClass self => self -> StateType -- ^ @state@ - the state for which to set the background color. -> Color -- ^ @color@ - the color to assign (does not need to be - -- allocated), or @Nothing@ to undo the effect of previous calls - -- to of 'widgetModifyBg'. + -- allocated). -> IO () widgetModifyBg self state color = with color $ \colorPtr -> @@ -1418,6 +1432,18 @@ ((fromIntegral . fromEnum) state) (castPtr colorPtr) +-- | Restores the background color for a widget in a particular state. This +-- undoes the effects of previous calls to `widgetModifyBg'. +-- +widgetRestoreBg :: WidgetClass self => self + -> StateType -- ^ @state@ - the state for which to restore the background color. + -> IO () +widgetRestoreBg self state = + {# call gtk_widget_modify_bg #} + (toWidget self) + ((fromIntegral . fromEnum) state) + nullPtr + -- %hash c:d2ba -- | Sets the text color for a widget in a particular state. All other style -- values are left untouched. The text color is the foreground color used along @@ -1427,8 +1453,7 @@ widgetModifyText :: WidgetClass self => self -> StateType -- ^ @state@ - the state for which to set the text color. -> Color -- ^ @color@ - the color to assign (does not need to be - -- allocated), or @Nothing@ to undo the effect of previous calls - -- to of 'widgetModifyText'. + -- allocated). -> IO () widgetModifyText self state color = with color $ \colorPtr -> @@ -1437,6 +1462,18 @@ ((fromIntegral . fromEnum) state) (castPtr colorPtr) +-- | Restores the text color for a widget in a particular state. This +-- undoes the effects of previous calls to `widgetModifyText'. +-- +widgetRestoreText :: WidgetClass self => self + -> StateType -- ^ @state@ - the state for which to restore the text color. + -> IO () +widgetRestoreText self state = + {# call gtk_widget_modify_text #} + (toWidget self) + ((fromIntegral . fromEnum) state) + nullPtr + -- %hash c:ac08 -- | Sets the base color for a widget in a particular state. All other style -- values are left untouched. The base color is the background color used along @@ -1453,8 +1490,7 @@ widgetModifyBase :: WidgetClass self => self -> StateType -- ^ @state@ - the state for which to set the base color. -> Color -- ^ @color@ - the color to assign (does not need to be - -- allocated), or @Nothing@ to undo the effect of previous calls - -- to of 'widgetModifyBase'. + -- allocated). -> IO () widgetModifyBase self state color = with color $ \colorPtr -> @@ -1462,6 +1498,19 @@ (toWidget self) ((fromIntegral . fromEnum) state) (castPtr colorPtr) + +-- | Restores the base color for a widget in a particular state. This undoes +-- the effects of previous calls to widgetModifyBase. +-- +widgetRestoreBase :: WidgetClass self => self + -> StateType -- ^ @state@ - the state for which to restore the base color. + -> IO () +widgetRestoreBase self state = + {# call gtk_widget_modify_base #} + (toWidget self) + ((fromIntegral . fromEnum) state) + nullPtr + -- %hash c:38d7 -- | Sets the font to use for a widget. All other style values are left diff --git a/Graphics/UI/Gtk/Gdk/Drawable.chs b/Graphics/UI/Gtk/Gdk/Drawable.chs --- a/Graphics/UI/Gtk/Gdk/Drawable.chs +++ b/Graphics/UI/Gtk/Gdk/Drawable.chs @@ -173,7 +173,7 @@ -- | Render a 'Pixbuf'. -- -- * Usage: --- @drawPixbuf d gc pb srcX srcY destX destY srcWidth srcHeight dither@ +-- @drawPixbuf d gc pb srcX srcY destX destY srcWidth srcHeight dither xDither yDither@ -- Renders a rectangular portion of a 'Pixbuf' to a -- 'Drawable'. The @srcX@, @srcY@, -- @srcWidth@ and @srcHeight@ specify what part of the @@ -221,8 +221,14 @@ -- 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 :: DrawableClass d => d -- ^ drawable + -> GC -- ^ graphics context + -> Bool -- ^ filled + -> Int -- ^ x + -> Int -- ^ y + -> Int -- ^ width + -> Int -- ^ height + -> 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) @@ -355,9 +361,17 @@ -- '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 :: (DrawableClass src, DrawableClass dest) + => dest -- ^ destination drawable + -> GC -- ^ graphics context + -> src -- ^ source drawable + -> Int -- ^ @xSrc@ + -> Int -- ^ @ySrc@ + -> Int -- ^ @xDest@ + -> Int -- ^ @yDest@ + -> Int -- ^ @width@ + -> Int -- ^ @height@ + -> IO () drawDrawable dest gc src xSrc ySrc xDest yDest width height = {#call unsafe draw_drawable#} (toDrawable dest) (toGC gc) (toDrawable src) diff --git a/Graphics/UI/Gtk/General/Structs.hsc b/Graphics/UI/Gtk/General/Structs.hsc --- a/Graphics/UI/Gtk/General/Structs.hsc +++ b/Graphics/UI/Gtk/General/Structs.hsc @@ -119,6 +119,10 @@ import Graphics.UI.Gtk.General.DNDTypes (InfoId, Atom(Atom) , SelectionTag, TargetTag, SelectionTypeTag) import Graphics.Rendering.Pango.Structs ( Color(..), Rectangle(..) ) +#if !defined(WIN32) || GTK_CHECK_VERSION(2,14,0) +#else +import Unsafe.Coerce +#endif -- | Represents the x and y coordinate of a point. -- type Point = (Int, Int) @@ -605,6 +609,12 @@ liftM toNativeWindowId $ (\(Drawable drawable) -> #if defined(WIN32) +#if GTK_CHECK_VERSION(2,14,0) +#else + -- GTK-2.12 is a bit sloppy about the distinction between pointers and + -- 32-bit ints, so we have to mimic that sloppiness here + liftM unsafeCoerce $ +#endif withForeignPtr drawable gdk_win32_drawable_get_handle #elif !defined(HAVE_QUARTZ_GTK) withForeignPtr drawable gdk_x11_drawable_get_xid diff --git a/Graphics/UI/Gtk/MenuComboToolbar/ComboBox.chs b/Graphics/UI/Gtk/MenuComboToolbar/ComboBox.chs --- a/Graphics/UI/Gtk/MenuComboToolbar/ComboBox.chs +++ b/Graphics/UI/Gtk/MenuComboToolbar/ComboBox.chs @@ -139,7 +139,6 @@ -- * Signals changed, - popupShownNotify, -- * Deprecated #ifndef DISABLE_DEPRECATED @@ -727,11 +726,6 @@ -- changed :: ComboBoxClass self => Signal self (IO ()) changed = Signal (connect_NONE__NONE "changed") - --- | The combo box was dropped down or collapsed. --- -popupShownNotify :: ComboBoxClass self => Signal self (IO ()) -popupShownNotify = Signal (connect_NONE__NONE "notify::popup-shown") -------------------- -- Deprecated Signals diff --git a/Graphics/UI/Gtk/Multiline/TextBuffer.chs b/Graphics/UI/Gtk/Multiline/TextBuffer.chs --- a/Graphics/UI/Gtk/Multiline/TextBuffer.chs +++ b/Graphics/UI/Gtk/Multiline/TextBuffer.chs @@ -1263,7 +1263,9 @@ -- | Some text was inserted. -- bufferInsertText :: TextBufferClass self => Signal self (TextIter -> String -> IO ()) -bufferInsertText = Signal (connect_BOXED_STRING__NONE "insert-text" mkTextIterCopy) +bufferInsertText = Signal $ \after obj handler -> + connect_BOXED_PTR_INT__NONE "insert-text" mkTextIterCopy after obj + (\iter strPtr strLen -> peekUTFStringLen (strPtr, strLen) >>= handler iter) -- | A 'TextMark' within the buffer was deleted. -- diff --git a/Graphics/UI/Gtk/Types.chs b/Graphics/UI/Gtk/Types.chs --- a/Graphics/UI/Gtk/Types.chs +++ b/Graphics/UI/Gtk/Types.chs @@ -40,6 +40,10 @@ toAtkObject, mkAtkObject, unAtkObject, castToAtkObject, gTypeAtkObject, + Accessible(Accessible), AccessibleClass, + toAccessible, + mkAccessible, unAccessible, + castToAccessible, gTypeAccessible, Keymap(Keymap), KeymapClass, toKeymap, mkKeymap, unKeymap, @@ -208,6 +212,14 @@ toContainer, mkContainer, unContainer, castToContainer, gTypeContainer, + ToolPalette(ToolPalette), ToolPaletteClass, + toToolPalette, + mkToolPalette, unToolPalette, + castToToolPalette, gTypeToolPalette, + ToolItemGroup(ToolItemGroup), ToolItemGroupClass, + toToolItemGroup, + mkToolItemGroup, unToolItemGroup, + castToToolItemGroup, gTypeToolItemGroup, Bin(Bin), BinClass, toBin, mkBin, unBin, @@ -304,6 +316,10 @@ toAssistant, mkAssistant, unAssistant, castToAssistant, gTypeAssistant, + OffscreenWindow(OffscreenWindow), OffscreenWindowClass, + toOffscreenWindow, + mkOffscreenWindow, unOffscreenWindow, + castToOffscreenWindow, gTypeOffscreenWindow, Dialog(Dialog), DialogClass, toDialog, mkDialog, unDialog, @@ -536,6 +552,10 @@ toDrawingArea, mkDrawingArea, unDrawingArea, castToDrawingArea, gTypeDrawingArea, + Spinner(Spinner), SpinnerClass, + toSpinner, + mkSpinner, unSpinner, + castToSpinner, gTypeSpinner, Entry(Entry), EntryClass, toEntry, mkEntry, unEntry, @@ -640,6 +660,10 @@ toCellRenderer, mkCellRenderer, unCellRenderer, castToCellRenderer, gTypeCellRenderer, + CellRendererSpinner(CellRendererSpinner), CellRendererSpinnerClass, + toCellRendererSpinner, + mkCellRendererSpinner, unCellRendererSpinner, + castToCellRendererSpinner, gTypeCellRendererSpinner, CellRendererPixbuf(CellRendererPixbuf), CellRendererPixbufClass, toCellRendererPixbuf, mkCellRendererPixbuf, unCellRendererPixbuf, @@ -838,6 +862,30 @@ gTypeAtkObject = {# call fun unsafe atk_object_get_type #} +-- ***************************************************************** Accessible + +{#pointer *Accessible foreign newtype #} deriving (Eq,Ord) + +mkAccessible = (Accessible, objectUnrefFromMainloop) +unAccessible (Accessible o) = o + +class AtkObjectClass o => AccessibleClass o +toAccessible :: AccessibleClass o => o -> Accessible +toAccessible = unsafeCastGObject . toGObject + +instance AccessibleClass Accessible +instance AtkObjectClass Accessible +instance GObjectClass Accessible where + toGObject = GObject . castForeignPtr . unAccessible + unsafeCastGObject = Accessible . castForeignPtr . unGObject + +castToAccessible :: GObjectClass obj => obj -> Accessible +castToAccessible = castTo gTypeAccessible "Accessible" + +gTypeAccessible :: GType +gTypeAccessible = + {# call fun unsafe gtk_accessible_get_type #} + -- ********************************************************************* Keymap {#pointer *GdkKeymap as Keymap foreign newtype #} deriving (Eq,Ord) @@ -1832,6 +1880,58 @@ gTypeContainer = {# call fun unsafe gtk_container_get_type #} +-- **************************************************************** ToolPalette + +{#pointer *ToolPalette foreign newtype #} deriving (Eq,Ord) + +mkToolPalette = (ToolPalette, objectUnrefFromMainloop) +unToolPalette (ToolPalette o) = o + +class ContainerClass o => ToolPaletteClass o +toToolPalette :: ToolPaletteClass o => o -> ToolPalette +toToolPalette = unsafeCastGObject . toGObject + +instance ToolPaletteClass ToolPalette +instance ContainerClass ToolPalette +instance WidgetClass ToolPalette +instance ObjectClass ToolPalette +instance GObjectClass ToolPalette where + toGObject = GObject . castForeignPtr . unToolPalette + unsafeCastGObject = ToolPalette . castForeignPtr . unGObject + +castToToolPalette :: GObjectClass obj => obj -> ToolPalette +castToToolPalette = castTo gTypeToolPalette "ToolPalette" + +gTypeToolPalette :: GType +gTypeToolPalette = + {# call fun unsafe gtk_tool_palette_get_type #} + +-- ************************************************************** ToolItemGroup + +{#pointer *ToolItemGroup foreign newtype #} deriving (Eq,Ord) + +mkToolItemGroup = (ToolItemGroup, objectUnrefFromMainloop) +unToolItemGroup (ToolItemGroup o) = o + +class ContainerClass o => ToolItemGroupClass o +toToolItemGroup :: ToolItemGroupClass o => o -> ToolItemGroup +toToolItemGroup = unsafeCastGObject . toGObject + +instance ToolItemGroupClass ToolItemGroup +instance ContainerClass ToolItemGroup +instance WidgetClass ToolItemGroup +instance ObjectClass ToolItemGroup +instance GObjectClass ToolItemGroup where + toGObject = GObject . castForeignPtr . unToolItemGroup + unsafeCastGObject = ToolItemGroup . castForeignPtr . unGObject + +castToToolItemGroup :: GObjectClass obj => obj -> ToolItemGroup +castToToolItemGroup = castTo gTypeToolItemGroup "ToolItemGroup" + +gTypeToolItemGroup :: GType +gTypeToolItemGroup = + {# call fun unsafe gtk_tool_item_group_get_type #} + -- ************************************************************************ Bin {#pointer *Bin foreign newtype #} deriving (Eq,Ord) @@ -2507,6 +2607,34 @@ gTypeAssistant = {# call fun unsafe gtk_assistant_get_type #} +-- ************************************************************ OffscreenWindow + +{#pointer *OffscreenWindow foreign newtype #} deriving (Eq,Ord) + +mkOffscreenWindow = (OffscreenWindow, objectUnrefFromMainloop) +unOffscreenWindow (OffscreenWindow o) = o + +class WindowClass o => OffscreenWindowClass o +toOffscreenWindow :: OffscreenWindowClass o => o -> OffscreenWindow +toOffscreenWindow = unsafeCastGObject . toGObject + +instance OffscreenWindowClass OffscreenWindow +instance WindowClass OffscreenWindow +instance BinClass OffscreenWindow +instance ContainerClass OffscreenWindow +instance WidgetClass OffscreenWindow +instance ObjectClass OffscreenWindow +instance GObjectClass OffscreenWindow where + toGObject = GObject . castForeignPtr . unOffscreenWindow + unsafeCastGObject = OffscreenWindow . castForeignPtr . unGObject + +castToOffscreenWindow :: GObjectClass obj => obj -> OffscreenWindow +castToOffscreenWindow = castTo gTypeOffscreenWindow "OffscreenWindow" + +gTypeOffscreenWindow :: GType +gTypeOffscreenWindow = + {# call fun unsafe gtk_offscreen_window_get_type #} + -- ********************************************************************* Dialog {#pointer *Dialog foreign newtype #} deriving (Eq,Ord) @@ -4090,6 +4218,32 @@ gTypeDrawingArea = {# call fun unsafe gtk_drawing_area_get_type #} +-- ******************************************************************** Spinner + +{#pointer *Spinner foreign newtype #} deriving (Eq,Ord) + +mkSpinner = (Spinner, objectUnrefFromMainloop) +unSpinner (Spinner o) = o + +class DrawingAreaClass o => SpinnerClass o +toSpinner :: SpinnerClass o => o -> Spinner +toSpinner = unsafeCastGObject . toGObject + +instance SpinnerClass Spinner +instance DrawingAreaClass Spinner +instance WidgetClass Spinner +instance ObjectClass Spinner +instance GObjectClass Spinner where + toGObject = GObject . castForeignPtr . unSpinner + unsafeCastGObject = Spinner . castForeignPtr . unGObject + +castToSpinner :: GObjectClass obj => obj -> Spinner +castToSpinner = castTo gTypeSpinner "Spinner" + +gTypeSpinner :: GType +gTypeSpinner = + {# call fun unsafe gtk_spinner_get_type #} + -- ********************************************************************** Entry {#pointer *Entry foreign newtype #} deriving (Eq,Ord) @@ -4748,6 +4902,31 @@ gTypeCellRenderer :: GType gTypeCellRenderer = {# call fun unsafe gtk_cell_renderer_get_type #} + +-- ******************************************************** CellRendererSpinner + +{#pointer *CellRendererSpinner foreign newtype #} deriving (Eq,Ord) + +mkCellRendererSpinner = (CellRendererSpinner, objectUnrefFromMainloop) +unCellRendererSpinner (CellRendererSpinner o) = o + +class CellRendererClass o => CellRendererSpinnerClass o +toCellRendererSpinner :: CellRendererSpinnerClass o => o -> CellRendererSpinner +toCellRendererSpinner = unsafeCastGObject . toGObject + +instance CellRendererSpinnerClass CellRendererSpinner +instance CellRendererClass CellRendererSpinner +instance ObjectClass CellRendererSpinner +instance GObjectClass CellRendererSpinner where + toGObject = GObject . castForeignPtr . unCellRendererSpinner + unsafeCastGObject = CellRendererSpinner . castForeignPtr . unGObject + +castToCellRendererSpinner :: GObjectClass obj => obj -> CellRendererSpinner +castToCellRendererSpinner = castTo gTypeCellRendererSpinner "CellRendererSpinner" + +gTypeCellRendererSpinner :: GType +gTypeCellRendererSpinner = + {# call fun unsafe gtk_cell_renderer_spinner_get_type #} -- ********************************************************* CellRendererPixbuf diff --git a/demo/demos.txt b/demo/demos.txt --- a/demo/demos.txt +++ b/demo/demos.txt @@ -27,9 +27,11 @@ concurrent: Show how to let Haskell programs continue while the GUI is running. +embedded: You will need uzbl installed (http://uzbl.org/) to run the Uzbl demo. + fastdraw: shows a palette of colors constantly changing (Example of a drawing graphics onto a canvas) -filechooser: examples of Save and Open dialogs. +filechooser: examples of Save and Open dialogs. requires the glade package fonts: shows info on all your installed fonts. @@ -91,6 +93,6 @@ Feature request: avoid svgviewer: user error (Pattern match failure in do expression at SvgViewer.hs:11:2-9) when not giving any parameter -treelist: some examples showing how to use ListView and TreeView widgets +treelist: some examples showing how to use ListView and TreeView widgets; requires the glade package unicode: Example of an international dialog box (in arabic) diff --git a/gtk.cabal b/gtk.cabal --- a/gtk.cabal +++ b/gtk.cabal @@ -1,5 +1,5 @@ Name: gtk -Version: 0.12.2 +Version: 0.12.3 License: LGPL-2.1 License-file: COPYING Copyright: (c) 2001-2010 The Gtk2Hs Team @@ -15,7 +15,7 @@ based on Gtk+. Gtk+ is an extensive and mature multi-platform toolkit for creating graphical user interfaces. Category: Graphics -Tested-With: GHC == 6.10.4, GHC == 6.12.3, GHC == 7.0.4, GHC == 7.2.1 +Tested-With: GHC == 7.0.4, GHC == 7.2.2, GHC == 7.4.1 Extra-Source-Files: wingtk.h Graphics/UI/Gtk/ModelView/Gtk2HsStore.h Graphics/UI/Gtk/General/hsgthread.h