diff --git a/Graphics/UI/Gtk.chs b/Graphics/UI/Gtk.chs --- a/Graphics/UI/Gtk.chs +++ b/Graphics/UI/Gtk.chs @@ -53,6 +53,7 @@ module Graphics.UI.Gtk.General.Clipboard, -- * Drawing and other Low-Level Operations + module Graphics.UI.Gtk.Gdk.AppLaunchContext, module Graphics.UI.Gtk.Gdk.Cursor, module Graphics.UI.Gtk.Gdk.Drawable, module Graphics.UI.Gtk.Gdk.DrawWindow, @@ -62,15 +63,19 @@ module Graphics.UI.Gtk.Gdk.Pixbuf, module Graphics.UI.Gtk.Gdk.Pixmap, module Graphics.UI.Gtk.Gdk.Screen, + module Graphics.UI.Gtk.Gdk.Keymap, module Graphics.UI.Gtk.Gdk.Display, + module Graphics.UI.Gtk.Gdk.DisplayManager, module Graphics.UI.Gtk.Gdk.Gdk, -- ** cairo integration module Graphics.UI.Gtk.Cairo, -- * Windows module Graphics.UI.Gtk.Windows.Window, + module Graphics.UI.Gtk.Windows.OffscreenWindow, module Graphics.UI.Gtk.Windows.Invisible, module Graphics.UI.Gtk.Windows.Dialog, module Graphics.UI.Gtk.Windows.AboutDialog, + module Graphics.UI.Gtk.Windows.Assistant, module Graphics.UI.Gtk.Windows.MessageDialog, module Graphics.UI.Gtk.Windows.WindowGroup, -- * Display widgets, @@ -78,16 +83,24 @@ module Graphics.UI.Gtk.Display.Image, module Graphics.UI.Gtk.Display.Label, module Graphics.UI.Gtk.Display.ProgressBar, + module Graphics.UI.Gtk.Display.Spinner, module Graphics.UI.Gtk.Display.Statusbar, module Graphics.UI.Gtk.Display.StatusIcon, +#if GTK_CHECK_VERSION(2,18,0) + module Graphics.UI.Gtk.Display.InfoBar, +#endif -- * Buttons and toggles module Graphics.UI.Gtk.Buttons.Button, module Graphics.UI.Gtk.Buttons.CheckButton, module Graphics.UI.Gtk.Buttons.RadioButton, module Graphics.UI.Gtk.Buttons.ToggleButton, + module Graphics.UI.Gtk.Buttons.LinkButton, + module Graphics.UI.Gtk.Buttons.ScaleButton, + module Graphics.UI.Gtk.Buttons.VolumeButton, -- * Numeric\/text data entry module Graphics.UI.Gtk.Entry.Editable, module Graphics.UI.Gtk.Entry.Entry, + module Graphics.UI.Gtk.Entry.EntryBuffer, module Graphics.UI.Gtk.Entry.EntryCompletion, module Graphics.UI.Gtk.Entry.HScale, module Graphics.UI.Gtk.Entry.VScale, @@ -100,12 +113,16 @@ module Graphics.UI.Gtk.Multiline.TextTagTable, module Graphics.UI.Gtk.Multiline.TextView, -- * Tree and list widget + module Graphics.UI.Gtk.ModelView.CellEditable, module Graphics.UI.Gtk.ModelView.CellLayout, module Graphics.UI.Gtk.ModelView.CellRenderer, + module Graphics.UI.Gtk.ModelView.CellRendererSpinner, module Graphics.UI.Gtk.ModelView.CellRendererCombo, module Graphics.UI.Gtk.ModelView.CellRendererPixbuf, module Graphics.UI.Gtk.ModelView.CellRendererProgress, module Graphics.UI.Gtk.ModelView.CellRendererText, + module Graphics.UI.Gtk.ModelView.CellRendererAccel, + module Graphics.UI.Gtk.ModelView.CellRendererSpin, module Graphics.UI.Gtk.ModelView.CellRendererToggle, module Graphics.UI.Gtk.ModelView.CellView, module Graphics.UI.Gtk.ModelView.CustomStore, @@ -136,6 +153,8 @@ module Graphics.UI.Gtk.MenuComboToolbar.TearoffMenuItem, module Graphics.UI.Gtk.MenuComboToolbar.Toolbar, module Graphics.UI.Gtk.MenuComboToolbar.ToolItem, + module Graphics.UI.Gtk.MenuComboToolbar.ToolItemGroup, + module Graphics.UI.Gtk.MenuComboToolbar.ToolPalette, module Graphics.UI.Gtk.MenuComboToolbar.ToolButton, module Graphics.UI.Gtk.MenuComboToolbar.MenuToolButton, module Graphics.UI.Gtk.MenuComboToolbar.ToggleToolButton, @@ -147,6 +166,7 @@ module Graphics.UI.Gtk.ActionMenuToolbar.ActionGroup, module Graphics.UI.Gtk.ActionMenuToolbar.ToggleAction, module Graphics.UI.Gtk.ActionMenuToolbar.RadioAction, + module Graphics.UI.Gtk.ActionMenuToolbar.RecentAction, module Graphics.UI.Gtk.ActionMenuToolbar.UIManager, -- * Selectors (file\/font\/color) module Graphics.UI.Gtk.Selectors.ColorSelection, @@ -156,6 +176,13 @@ module Graphics.UI.Gtk.Selectors.FontSelection, module Graphics.UI.Gtk.Selectors.FontSelectionDialog, module Graphics.UI.Gtk.Selectors.FontButton, +#if GTK_CHECK_VERSION(2,14,0) + module Graphics.UI.Gtk.Selectors.HSV, +#endif + -- * Special-purpose features + module Graphics.UI.Gtk.Special.Ruler, + module Graphics.UI.Gtk.Special.HRuler, + module Graphics.UI.Gtk.Special.VRuler, -- module InputDialog, -- ** File chooser module Graphics.UI.Gtk.Selectors.FileChooser, @@ -181,11 +208,25 @@ module Graphics.UI.Gtk.Ornaments.Frame, module Graphics.UI.Gtk.Ornaments.HSeparator, module Graphics.UI.Gtk.Ornaments.VSeparator, + -- * Printing + module Graphics.UI.Gtk.Printing.PaperSize, + module Graphics.UI.Gtk.Printing.PageSetup, + module Graphics.UI.Gtk.Printing.PrintContext, + module Graphics.UI.Gtk.Printing.PrintOperation, + module Graphics.UI.Gtk.Printing.PrintSettings, + -- * Recent + module Graphics.UI.Gtk.Recent.RecentChooserMenu, + module Graphics.UI.Gtk.Recent.RecentChooserWidget, + module Graphics.UI.Gtk.Recent.RecentFilter, + module Graphics.UI.Gtk.Recent.RecentManager, + module Graphics.UI.Gtk.Recent.RecentInfo, + module Graphics.UI.Gtk.Recent.RecentChooser, -- * Scrolling module Graphics.UI.Gtk.Scrolling.HScrollbar, module Graphics.UI.Gtk.Scrolling.ScrolledWindow, module Graphics.UI.Gtk.Scrolling.VScrollbar, -- * Miscellaneous + module Graphics.UI.Gtk.Misc.Accessible, module Graphics.UI.Gtk.Misc.Adjustment, module Graphics.UI.Gtk.Misc.Arrow, module Graphics.UI.Gtk.Misc.Calendar, @@ -193,6 +234,7 @@ module Graphics.UI.Gtk.Misc.EventBox, module Graphics.UI.Gtk.Misc.HandleBox, module Graphics.UI.Gtk.Misc.IMMulticontext, + module Graphics.UI.Gtk.Misc.IMContextSimple, module Graphics.UI.Gtk.Misc.SizeGroup, module Graphics.UI.Gtk.Misc.Tooltip, module Graphics.UI.Gtk.Misc.Tooltips, @@ -241,6 +283,7 @@ import Graphics.UI.Gtk.Gdk.Keys import Graphics.UI.Gtk.General.Style import Graphics.UI.Gtk.General.RcStyle +import Graphics.UI.Gtk.Gdk.AppLaunchContext import Graphics.UI.Gtk.Gdk.Cursor import Graphics.UI.Gtk.Gdk.Drawable import Graphics.UI.Gtk.Gdk.DrawWindow @@ -250,15 +293,19 @@ import Graphics.UI.Gtk.Gdk.Pixbuf import Graphics.UI.Gtk.Gdk.Pixmap import Graphics.UI.Gtk.Gdk.Screen +import Graphics.UI.Gtk.Gdk.Keymap import Graphics.UI.Gtk.Gdk.Display +import Graphics.UI.Gtk.Gdk.DisplayManager import Graphics.UI.Gtk.Gdk.Gdk -- cairo integration import Graphics.UI.Gtk.Cairo -- windows import Graphics.UI.Gtk.Windows.Dialog import Graphics.UI.Gtk.Windows.Window +import Graphics.UI.Gtk.Windows.OffscreenWindow import Graphics.UI.Gtk.Windows.Invisible import Graphics.UI.Gtk.Windows.AboutDialog +import Graphics.UI.Gtk.Windows.Assistant import Graphics.UI.Gtk.Windows.MessageDialog import Graphics.UI.Gtk.Windows.WindowGroup -- display widgets @@ -266,20 +313,28 @@ import Graphics.UI.Gtk.Display.Image import Graphics.UI.Gtk.Display.Label import Graphics.UI.Gtk.Display.ProgressBar +import Graphics.UI.Gtk.Display.Spinner import Graphics.UI.Gtk.Display.Statusbar #if GTK_CHECK_VERSION(2,10,0) && !DISABLE_DEPRECATED import Graphics.UI.Gtk.Display.StatusIcon hiding (onActivate,afterActivate,onPopupMenu,afterPopupMenu) #else import Graphics.UI.Gtk.Display.StatusIcon #endif +#if GTK_CHECK_VERSION(2,18,0) +import Graphics.UI.Gtk.Display.InfoBar +#endif -- buttons and toggles import Graphics.UI.Gtk.Buttons.Button import Graphics.UI.Gtk.Buttons.CheckButton import Graphics.UI.Gtk.Buttons.RadioButton import Graphics.UI.Gtk.Buttons.ToggleButton +import Graphics.UI.Gtk.Buttons.LinkButton +import Graphics.UI.Gtk.Buttons.ScaleButton +import Graphics.UI.Gtk.Buttons.VolumeButton -- numeric\/text data entry import Graphics.UI.Gtk.Entry.Editable import Graphics.UI.Gtk.Entry.Entry +import Graphics.UI.Gtk.Entry.EntryBuffer import Graphics.UI.Gtk.Entry.EntryCompletion import Graphics.UI.Gtk.Entry.HScale import Graphics.UI.Gtk.Entry.VScale @@ -293,12 +348,16 @@ import qualified Graphics.UI.Gtk.Multiline.TextView import Graphics.UI.Gtk.Multiline.TextView -- tree and list widget +import Graphics.UI.Gtk.ModelView.CellEditable import Graphics.UI.Gtk.ModelView.CellLayout import Graphics.UI.Gtk.ModelView.CellRenderer +import Graphics.UI.Gtk.ModelView.CellRendererSpinner import Graphics.UI.Gtk.ModelView.CellRendererCombo import Graphics.UI.Gtk.ModelView.CellRendererPixbuf import Graphics.UI.Gtk.ModelView.CellRendererProgress import Graphics.UI.Gtk.ModelView.CellRendererText +import Graphics.UI.Gtk.ModelView.CellRendererAccel +import Graphics.UI.Gtk.ModelView.CellRendererSpin import Graphics.UI.Gtk.ModelView.CellRendererToggle import Graphics.UI.Gtk.ModelView.CellView import Graphics.UI.Gtk.ModelView.CustomStore @@ -330,6 +389,8 @@ import Graphics.UI.Gtk.MenuComboToolbar.TearoffMenuItem import Graphics.UI.Gtk.MenuComboToolbar.Toolbar import Graphics.UI.Gtk.MenuComboToolbar.ToolItem +import Graphics.UI.Gtk.MenuComboToolbar.ToolItemGroup +import Graphics.UI.Gtk.MenuComboToolbar.ToolPalette import Graphics.UI.Gtk.MenuComboToolbar.ToolButton import Graphics.UI.Gtk.MenuComboToolbar.MenuToolButton import Graphics.UI.Gtk.MenuComboToolbar.ToggleToolButton @@ -341,6 +402,7 @@ import Graphics.UI.Gtk.ActionMenuToolbar.ActionGroup import Graphics.UI.Gtk.ActionMenuToolbar.ToggleAction import Graphics.UI.Gtk.ActionMenuToolbar.RadioAction +import Graphics.UI.Gtk.ActionMenuToolbar.RecentAction import Graphics.UI.Gtk.ActionMenuToolbar.UIManager -- selectors (file\/font\/color\/input device) import Graphics.UI.Gtk.Selectors.ColorSelection @@ -355,6 +417,13 @@ import Graphics.UI.Gtk.Selectors.FontSelection import Graphics.UI.Gtk.Selectors.FontSelectionDialog import Graphics.UI.Gtk.Selectors.FontButton +#if GTK_CHECK_VERSION(2,14,0) +import Graphics.UI.Gtk.Selectors.HSV +#endif +-- Special-purpose features +import Graphics.UI.Gtk.Special.Ruler +import Graphics.UI.Gtk.Special.HRuler +import Graphics.UI.Gtk.Special.VRuler --import InputDialog -- layout containers import Graphics.UI.Gtk.Layout.Alignment @@ -374,11 +443,25 @@ import Graphics.UI.Gtk.Ornaments.Frame import Graphics.UI.Gtk.Ornaments.HSeparator import Graphics.UI.Gtk.Ornaments.VSeparator +-- printing +import Graphics.UI.Gtk.Printing.PaperSize +import Graphics.UI.Gtk.Printing.PageSetup +import Graphics.UI.Gtk.Printing.PrintContext +import Graphics.UI.Gtk.Printing.PrintOperation +import Graphics.UI.Gtk.Printing.PrintSettings +-- recent +import Graphics.UI.Gtk.Recent.RecentChooserMenu +import Graphics.UI.Gtk.Recent.RecentChooserWidget +import Graphics.UI.Gtk.Recent.RecentFilter +import Graphics.UI.Gtk.Recent.RecentManager +import Graphics.UI.Gtk.Recent.RecentInfo +import Graphics.UI.Gtk.Recent.RecentChooser -- scrolling import Graphics.UI.Gtk.Scrolling.HScrollbar import Graphics.UI.Gtk.Scrolling.VScrollbar import Graphics.UI.Gtk.Scrolling.ScrolledWindow -- miscellaneous +import Graphics.UI.Gtk.Misc.Accessible import Graphics.UI.Gtk.Misc.Adjustment import Graphics.UI.Gtk.Misc.Arrow import Graphics.UI.Gtk.Misc.Calendar @@ -386,6 +469,7 @@ import Graphics.UI.Gtk.Misc.EventBox import Graphics.UI.Gtk.Misc.HandleBox import Graphics.UI.Gtk.Misc.IMMulticontext +import Graphics.UI.Gtk.Misc.IMContextSimple import Graphics.UI.Gtk.Misc.SizeGroup import Graphics.UI.Gtk.Misc.Tooltip import Graphics.UI.Gtk.Misc.Tooltips diff --git a/Graphics/UI/Gtk/Abstract/Bin.chs b/Graphics/UI/Gtk/Abstract/Bin.chs --- a/Graphics/UI/Gtk/Abstract/Bin.chs +++ b/Graphics/UI/Gtk/Abstract/Bin.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Bin -- diff --git a/Graphics/UI/Gtk/Abstract/Box.chs b/Graphics/UI/Gtk/Abstract/Box.chs --- a/Graphics/UI/Gtk/Abstract/Box.chs +++ b/Graphics/UI/Gtk/Abstract/Box.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Box -- diff --git a/Graphics/UI/Gtk/Abstract/Container.chs b/Graphics/UI/Gtk/Abstract/Container.chs --- a/Graphics/UI/Gtk/Abstract/Container.chs +++ b/Graphics/UI/Gtk/Abstract/Container.chs @@ -524,10 +524,10 @@ -- | Emitted when widgets need to be queried again for their preferred size. -- checkResize :: ContainerClass self => Signal self (IO ()) -checkResize = Signal (connect_NONE__NONE "check_resize") +checkResize = Signal (connect_NONE__NONE "check-resize") -- %hash c:b3a d:af3f --- | A widget in the container received the input focus. +-- | A widget in the container received or lost the input focus. -- setFocusChild :: ContainerClass self => Signal self (Maybe Widget -> IO ()) setFocusChild = Signal (connect_MOBJECT__NONE "set-focus-child") diff --git a/Graphics/UI/Gtk/Abstract/IMContext.chs b/Graphics/UI/Gtk/Abstract/IMContext.chs --- a/Graphics/UI/Gtk/Abstract/IMContext.chs +++ b/Graphics/UI/Gtk/Abstract/IMContext.chs @@ -275,20 +275,20 @@ -- | This signal is emitted when a new preediting sequence starts. -- imContextPreeditStart :: IMContextClass self => Signal self (IO ()) -imContextPreeditStart = Signal (connect_NONE__NONE "preedit_start") +imContextPreeditStart = Signal (connect_NONE__NONE "preedit-start") -- | This signal is emitted when a preediting sequence has been completed or -- canceled. -- imContextPreeditEnd :: IMContextClass self => Signal self (IO ()) -imContextPreeditEnd = Signal (connect_NONE__NONE "preedit_end") +imContextPreeditEnd = Signal (connect_NONE__NONE "preedit-end") -- | This signal is emitted whenever the preedit sequence currently being -- entered has changed. It is also emitted at the end of a preedit sequence, -- in which case 'imContextGetPreeditString' returns the empty string. -- imContextPreeditChanged :: IMContextClass self => Signal self (IO ()) -imContextPreeditChanged = Signal (connect_NONE__NONE "preedit_changed") +imContextPreeditChanged = Signal (connect_NONE__NONE "preedit-changed") -- | This signal is emitted when a complete input sequence has been -- entered by the user. This can be a single character immediately after a @@ -304,7 +304,7 @@ -- -- Returns True if the signal was handled. imContextRetrieveSurrounding :: IMContextClass self => Signal self (IO Bool) -imContextRetrieveSurrounding = Signal (connect_NONE__BOOL "retrieve_surrounding") +imContextRetrieveSurrounding = Signal (connect_NONE__BOOL "retrieve-surrounding") -- | This signal is emitted when the input method needs to delete all or part -- of the context surrounding the cursor. Parameters: @@ -316,4 +316,4 @@ -- -- Returns True if the signal was handled. imContextDeleteSurrounding' :: IMContextClass self => Signal self (Int -> Int -> IO Bool) -imContextDeleteSurrounding' = Signal (connect_INT_INT__BOOL "delete_surrounding") +imContextDeleteSurrounding' = Signal (connect_INT_INT__BOOL "delete-surrounding") diff --git a/Graphics/UI/Gtk/Abstract/Misc.chs b/Graphics/UI/Gtk/Abstract/Misc.chs --- a/Graphics/UI/Gtk/Abstract/Misc.chs +++ b/Graphics/UI/Gtk/Abstract/Misc.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Misc -- diff --git a/Graphics/UI/Gtk/Abstract/Paned.chs b/Graphics/UI/Gtk/Abstract/Paned.chs --- a/Graphics/UI/Gtk/Abstract/Paned.chs +++ b/Graphics/UI/Gtk/Abstract/Paned.chs @@ -82,6 +82,9 @@ panedGetChild1, panedGetChild2, #endif +#if GTK_CHECK_VERSION(2,20,0) + panedGetHandleWindow, +#endif -- * Attributes panedPosition, @@ -226,6 +229,18 @@ maybeNull (makeNewObject mkWidget) $ {# call unsafe paned_get_child2 #} (toPaned self) +#endif + +#if GTK_CHECK_VERSION(2,20,0) +-- | Returns the 'Window' of the handle. This function is useful when handling button or motion events +-- because it enables the callback to distinguish between the window of the paned, a child and the +-- handle. +panedGetHandleWindow :: PanedClass self => self + -> IO DrawWindow +panedGetHandleWindow self = + makeNewGObject mkDrawWindow $ + {#call gtk_paned_get_handle_window #} + (toPaned self) #endif -------------------- diff --git a/Graphics/UI/Gtk/Abstract/Range.chs b/Graphics/UI/Gtk/Abstract/Range.chs --- a/Graphics/UI/Gtk/Abstract/Range.chs +++ b/Graphics/UI/Gtk/Abstract/Range.chs @@ -68,6 +68,14 @@ rangeSetUpperStepperSensitivity, rangeGetUpperStepperSensitivity, #endif +#if GTK_CHECK_VERSION(2,20,0) + rangeGetMinSliderSize, + rangeGetRangeRect, + rangeGetSliderRange, + rangeGetSliderSizeFixed, + rangeSetMinSliderSize, + rangeSetSliderSizeFixed, +#endif -- * Attributes rangeUpdatePolicy, @@ -78,6 +86,10 @@ rangeUpperStepperSensitivity, #endif rangeValue, +#if GTK_CHECK_VERSION(2,20,0) + rangeSliderSizeFixed, + rangeMinSliderSize, +#endif -- * Signals adjustBounds, @@ -110,6 +122,7 @@ {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.Enums (UpdateType(..), ScrollType(..)) +import Graphics.UI.Gtk.General.Structs (Rectangle(..)) {# context lib="gtk" prefix="gtk" #} @@ -305,7 +318,83 @@ {# call gtk_range_get_upper_stepper_sensitivity #} (toRange self) #endif +#if GTK_CHECK_VERSION(2,20,0) +-- | This function is useful mainly for 'Range' subclasses. +-- +-- See 'rangeSetMinSliderSize'. +rangeGetMinSliderSize :: RangeClass self => self + -> IO Int -- ^ returns The minimum size of the range's slider. +rangeGetMinSliderSize range = + liftM fromIntegral $ + {#call gtk_range_get_min_slider_size #} + (toRange range) +-- | This function returns the area that contains the range's trough and its steppers, in 'DrawWindow' +-- coordinates. +-- +-- This function is useful mainly for 'Range' subclasses. +rangeGetRangeRect :: RangeClass self => self + -> IO Rectangle +rangeGetRangeRect self = + alloca $ \rPtr -> do + {# call gtk_range_get_range_rect #} + (toRange self) + (castPtr rPtr) + peek rPtr + +-- | This function returns sliders range along the long dimension, in 'DrawWindow' coordinates. +-- +-- This function is useful mainly for 'Range' subclasses. +rangeGetSliderRange :: RangeClass self => self + -> IO (Maybe (Int, Int)) +rangeGetSliderRange range = + alloca $ \ startPtr -> + alloca $ \ endPtr -> do + {#call gtk_range_get_slider_range #} + (toRange range) + startPtr + endPtr + if (startPtr /= nullPtr && endPtr /= nullPtr) + then do + start <- peek startPtr + end <- peek endPtr + return (Just (fromIntegral start, fromIntegral end)) + else return Nothing + +-- | This function is useful mainly for 'Range' subclasses. +-- +-- See 'rangeSetSliderSizeFixed'. +rangeGetSliderSizeFixed :: RangeClass self => self + -> IO Bool -- ^ returns whether the range's slider has a fixed size. +rangeGetSliderSizeFixed self = + liftM toBool $ + {#call gtk_range_get_slider_size_fixed #} + (toRange self) + +-- | Sets the minimum size of the range's slider. +-- +-- This function is useful mainly for 'Range' subclasses. +rangeSetMinSliderSize :: RangeClass self => self + -> Bool + -> IO () +rangeSetMinSliderSize self minSize = + {#call gtk_range_set_min_slider_size #} + (toRange self) + (fromBool minSize) + +-- | Sets whether the range's slider has a fixed size, or a size that depends on it's adjustment's page +-- size. +-- +-- This function is useful mainly for 'Range' subclasses. +rangeSetSliderSizeFixed :: RangeClass self => self + -> Bool -- ^ @sizeFixed@ 'True' to make the slider size constant + -> IO () +rangeSetSliderSizeFixed self sizeFixed = + {#call gtk_range_set_slider_size_fixed #} + (toRange self) + (fromBool sizeFixed) +#endif + -------------------- -- Attributes @@ -364,6 +453,20 @@ rangeGetValue rangeSetValue +#if GTK_CHECK_VERSION(2,20,0) +-- | Wheter range's slikder has a fixed size, or a size that depends on it's adjustment's page size. +rangeSliderSizeFixed :: RangeClass self => Attr self Bool +rangeSliderSizeFixed = newAttr + rangeGetSliderSizeFixed + rangeSetSliderSizeFixed + +-- | Get\/Set sliders range along the long dimension, in 'DrawWindow' coordinates. +rangeMinSliderSize :: RangeClass self => ReadWriteAttr self Int Bool +rangeMinSliderSize = newAttr + rangeGetMinSliderSize + rangeSetMinSliderSize +#endif + -------------------- -- Signals @@ -371,13 +474,13 @@ -- | Emitted when the range value changes. -- valueChanged :: RangeClass self => Signal self (IO ()) -valueChanged = Signal (connect_NONE__NONE "value_changed") +valueChanged = Signal (connect_NONE__NONE "value-changed") -- %hash c:9576 d:af3f -- | -- adjustBounds :: RangeClass self => Signal self (Double -> IO ()) -adjustBounds = Signal (connect_DOUBLE__NONE "adjust_bounds") +adjustBounds = Signal (connect_DOUBLE__NONE "adjust-bounds") #if GTK_CHECK_VERSION(2,6,0) -- %hash c:a84 d:a60c @@ -398,7 +501,7 @@ -- * Available since Gtk+ version 2.6 -- changeValue :: RangeClass self => Signal self (ScrollType -> Double -> IO Bool) -changeValue = Signal (connect_ENUM_DOUBLE__BOOL "change_value") +changeValue = Signal (connect_ENUM_DOUBLE__BOOL "change-value") #endif -------------------- diff --git a/Graphics/UI/Gtk/Abstract/Scale.chs b/Graphics/UI/Gtk/Abstract/Scale.chs --- a/Graphics/UI/Gtk/Abstract/Scale.chs +++ b/Graphics/UI/Gtk/Abstract/Scale.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Scale -- 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 @@ -145,6 +145,9 @@ widgetSetTooltipWindow, widgetTriggerTooltipQuery, #endif +#if GTK_CHECK_VERSION(2,14,0) + widgetGetSnapshot, +#endif widgetPath, widgetClassPath, widgetGetCompositeName, @@ -173,7 +176,7 @@ widgetGetParent, widgetGetSettings, #if GTK_CHECK_VERSION(2,2,0) - --widgetGetClipboard, + widgetGetClipboard, widgetGetDisplay, widgetGetRootWindow, widgetGetScreen, @@ -230,6 +233,11 @@ widgetTooltipMarkup, widgetTooltipText, widgetHasTooltip, +#if GTK_CHECK_VERSION(2,20,0) + widgetHasRcStyle, + widgetGetRealized, + widgetGetMapped, +#endif -- * Signals realize, @@ -366,11 +374,12 @@ import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties -import System.Glib.GObject (constructNewGObject, makeNewGObject) +import System.Glib.GObject (wrapNewGObject, makeNewGObject) import System.Glib.GType (GType) import System.Glib.GList (GList, fromGList) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) import Graphics.Rendering.Pango.Markup +import Graphics.UI.Gtk.General.DNDTypes (Atom (Atom), SelectionTag) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.Gdk.Enums (EventMask(..), ExtensionMode(..)) @@ -1223,6 +1232,38 @@ (toWidget self) #endif +#if GTK_CHECK_VERSION(2,14,0) +-- | Create a 'Pixmap' of the contents of the widget and its children. +-- +-- Works even if the widget is obscured. The depth and visual of the resulting pixmap is dependent on +-- the widget being snapshot and likely differs from those of a target widget displaying the +-- pixmap. The function 'pixbufGetFromDrawable' can be used to convert the pixmap to a visual +-- independant representation. +-- +-- The snapshot area used by this function is the widget's allocation plus any extra space occupied by +-- additional windows belonging to this widget (such as the arrows of a spin button). Thus, the +-- resulting snapshot pixmap is possibly larger than the allocation. +-- +-- The resulting pixmap is shrunken to match the specified @clipRect@. The +-- (x,y) coordinates of @clipRect@ are interpreted widget relative. If width or height of @clipRect@ are +-- 0 or negative, the width or height of the resulting pixmap will be shrunken by the respective +-- amount. For instance a @clipRect@ { +5, +5, -10, -10 } will chop off 5 pixels at each side of the +-- snapshot pixmap. @clipRect@ will contain the exact widget-relative snapshot coordinates +-- upon return. A @clipRect@ of { -1, -1, 0, 0 } can be used to preserve the auto-grown snapshot area +-- and use @clipRect@ as a pure output parameter. +-- +-- The returned pixmap can be 'Nothing', if the resulting @clipArea@ was empty. +widgetGetSnapshot :: WidgetClass self => self + -> Rectangle + -> IO (Maybe Pixmap) -- ^ returns 'Pixmap' snapshot of the widget +widgetGetSnapshot widget clipRect = + maybeNull (wrapNewGObject mkPixmap) $ + with clipRect $ \ clipRectPtr -> + {#call gtk_widget_get_snapshot #} + (toWidget widget) + (castPtr clipRectPtr) +#endif + -- %hash c:7e36 d:616f -- | Obtains the full path to @widget@. The path is simply the name of a -- widget and all its parents in the container hierarchy, separated by periods. @@ -1438,7 +1479,7 @@ widgetCreatePangoContext :: WidgetClass self => self -> IO PangoContext -- ^ returns the new 'PangoContext' widgetCreatePangoContext self = - constructNewGObject mkPangoContext $ + wrapNewGObject mkPangoContext $ {# call gtk_widget_create_pango_context #} (toWidget self) @@ -1483,7 +1524,7 @@ -> String -- ^ @text@ - text to set on the layout -> IO PangoLayout widgetCreateLayout self text = do - pl <- constructNewGObject mkPangoLayoutRaw $ + pl <- wrapNewGObject mkPangoLayoutRaw $ withUTFString text $ \textPtr -> {# call unsafe widget_create_pango_layout #} (toWidget self) @@ -1514,7 +1555,7 @@ -> IO (Maybe Pixbuf) -- ^ returns a new pixbuf, or @Nothing@ if the stock ID -- wasn't known widgetRenderIcon self stockId size detail = - maybeNull (makeNewGObject mkPixbuf) $ + maybeNull (wrapNewGObject mkPixbuf) $ withUTFString detail $ \detailPtr -> withUTFString stockId $ \stockIdPtr -> {# call gtk_widget_render_icon #} @@ -1783,6 +1824,25 @@ #if GTK_CHECK_VERSION(2,2,0) +-- | Returns the clipboard object for the given selection to +-- be used with widget. widget must have a 'Display' +-- associated with it, so must be attached to a toplevel +-- window. +widgetGetClipboard :: WidgetClass self => self + -> SelectionTag -- ^ @selection@ a 'Atom' which identifies the clipboard + -- to use. 'selectionClipboard' gives the + -- default clipboard. Another common value + -- is 'selectionPrimary', which gives + -- the primary X selection. + -> IO Clipboard -- ^ returns the appropriate clipboard object. If no + -- clipboard already exists, a new one will + -- be created. +widgetGetClipboard self (Atom tagPtr) = + makeNewGObject mkClipboard $ + {#call gtk_widget_get_clipboard #} + (toWidget self) + tagPtr + -- %hash c:45ed d:52ef -- | Get the 'Display' for the toplevel window associated with this widget. -- This function can only be called after the widget has been added to a widget @@ -2331,6 +2391,33 @@ widgetHasTooltip :: WidgetClass self => Attr self Bool widgetHasTooltip = newAttrFromBoolProperty "has-tooltip" +#if GTK_CHECK_VERSION(2,20,0) +-- | Determines if the widget style has been looked up through the rc mechanism. +widgetHasRcStyle :: WidgetClass self => self + -> IO Bool -- ^ returns 'True' if the widget has been looked up through the rc mechanism, 'False' otherwise. +widgetHasRcStyle self = + liftM toBool $ + {#call gtk_widget_has_rc_style #} + (toWidget self) + +-- | Determines whether widget is realized. +widgetGetRealized :: WidgetClass self => self + -> IO Bool -- ^ returns 'True' if widget is realized, 'False' otherwise +widgetGetRealized self = + liftM toBool $ + {#call gtk_widget_get_realized #} + (toWidget self) + +-- | Whether the widget is mapped. +widgetGetMapped :: WidgetClass self => self + -> IO Bool -- ^ returns 'True' if the widget is mapped, 'False' otherwise. +widgetGetMapped self = + liftM toBool $ + {#call gtk_widget_get_mapped #} + (toWidget self) + +#endif + -------------------- -- Signals @@ -2373,7 +2460,7 @@ -- sizeRequest :: WidgetClass self => Signal self (IO Requisition) sizeRequest = Signal (\after w fun -> - connect_PTR__NONE "size_request" after w + connect_PTR__NONE "size-request" after w (\rqPtr -> fun >>= \req -> unless (rqPtr==nullPtr) $ poke rqPtr req)) -- %hash c:8ec5 d:af3f @@ -2384,7 +2471,7 @@ -- inform the widget about the real size it should occupy. -- sizeAllocate :: WidgetClass self => Signal self (Allocation -> IO ()) -sizeAllocate = Signal (connect_BOXED__NONE "size_allocate" peek) +sizeAllocate = Signal (connect_BOXED__NONE "size-allocate" peek) -- %hash c:ae3e d:af3f -- | The widget is shown. @@ -2408,14 +2495,14 @@ -- | The state of the widget (input focus, insensitive, etc.) has changed. -- stateChanged :: WidgetClass self => Signal self (StateType -> IO ()) -stateChanged = Signal (connect_ENUM__NONE "state_changed") +stateChanged = Signal (connect_ENUM__NONE "state-changed") -- %hash c:bef2 d:1d66 --- | The parent-set signal is emitted when a new parent has been set on a +-- | The 'parentSet' signal is emitted when a new parent has been set on a -- widget. The parameter is the new parent. -- parentSet :: WidgetClass self => Signal self (Maybe Widget -> IO ()) -parentSet = Signal (connect_MOBJECT__NONE "parent_set") +parentSet = Signal (connect_MOBJECT__NONE "parent-set") -- %hash c:7e2b d:4049 -- | Emitted when there is a change in the hierarchy to which a widget belong. @@ -2424,21 +2511,21 @@ -- anchored or vice-versa. -- hierarchyChanged :: WidgetClass self => Signal self (Maybe Widget -> IO ()) -hierarchyChanged = Signal (connect_MOBJECT__NONE "hierarchy_changed") +hierarchyChanged = Signal (connect_MOBJECT__NONE "hierarchy-changed") -- %hash c:5894 d:ba10 --- | The style-set signal is emitted when a new style has been set on a +-- | The 'styleSet' signal is emitted when a new style has been set on a -- widget. Note that style-modifying functions like 'widgetModifyBase' also -- cause this signal to be emitted. -- styleSet :: WidgetClass self => Signal self (Style -> IO ()) -styleSet = Signal (connect_OBJECT__NONE "style_set") +styleSet = Signal (connect_OBJECT__NONE "style-set") -- %hash c:6bb1 d:af3f -- | The default direction of text writing has changed. -- directionChanged :: WidgetClass self => Signal self (TextDirection -> IO ()) -directionChanged = Signal (connect_ENUM__NONE "direction_changed") +directionChanged = Signal (connect_ENUM__NONE "direction-changed") -- %hash c:c28c d:d116 -- | The 'grabNotify' signal is emitted when a widget becomes shadowed by a @@ -2449,7 +2536,7 @@ -- grab stack of its window group is not its ancestor. -- grabNotify :: WidgetClass self => Signal self (Bool -> IO ()) -grabNotify = Signal (connect_BOOL__NONE "grab_notify") +grabNotify = Signal (connect_BOOL__NONE "grab-notify") -- %hash c:e06c d:a681 -- | This signal gets emitted whenever a widget should pop up a @@ -2459,7 +2546,7 @@ -- creates a menu with clipboard commands. -- popupMenuSignal :: WidgetClass self => Signal self (IO Bool) -popupMenuSignal = Signal (connect_NONE__BOOL "popup_menu") +popupMenuSignal = Signal (connect_NONE__BOOL "popup-menu") -- | Specify what kind of help the user wants. {#enum GtkWidgetHelpType as WidgetHelpType {underscoreToCase} deriving (Eq,Show) #} @@ -2469,19 +2556,19 @@ -- if help has been shown. -- showHelp :: WidgetClass self => Signal self (WidgetHelpType -> IO Bool) -showHelp = Signal (connect_ENUM__BOOL "show_help") +showHelp = Signal (connect_ENUM__BOOL "show-help") -- %hash c:6a8f d:af3f -- | The set of keyboard accelerators has changed. -- accelClosuresChanged :: WidgetClass self => Signal self (IO ()) -accelClosuresChanged = Signal (connect_NONE__NONE "accel_closures_changed") +accelClosuresChanged = Signal (connect_NONE__NONE "accel-closures-changed") -- %hash c:5ca d:af3f -- | The widget moved to a new screen. -- screenChanged :: WidgetClass self => Signal self (Screen -> IO ()) -screenChanged = Signal (connect_OBJECT__NONE "screen_changed") +screenChanged = Signal (connect_OBJECT__NONE "screen-changed") -- | Emitted when 'hasTooltip' is 'True' and the 'gtkTooltipTimeout' has expired with the cursor -- hovering "above" widget; or emitted when widget got focus in keyboard mode. @@ -2497,7 +2584,7 @@ queryTooltip :: WidgetClass self => Signal self (Widget -> Maybe Point -> Tooltip -> IO Bool) queryTooltip = Signal (\after model user -> - connect_OBJECT_INT_INT_BOOL_OBJECT__BOOL "query_tooltip" + connect_OBJECT_INT_INT_BOOL_OBJECT__BOOL "query-tooltip" after model (\widget x y keyb tooltip -> user widget (if keyb then Nothing else Just (x, y)) tooltip)) diff --git a/Graphics/UI/Gtk/ActionMenuToolbar/Action.chs b/Graphics/UI/Gtk/ActionMenuToolbar/Action.chs --- a/Graphics/UI/Gtk/ActionMenuToolbar/Action.chs +++ b/Graphics/UI/Gtk/ActionMenuToolbar/Action.chs @@ -2,11 +2,12 @@ -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Action -- --- Author : Duncan Coutts +-- Author : Duncan Coutts, Andy Stewart -- -- Created: 6 April 2005 -- -- Copyright (C) 2005 Duncan Coutts +-- Copyright (C) 2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public @@ -128,6 +129,9 @@ actionVisible, actionAccelPath, #endif +#if GTK_CHECK_VERSION(2,20,0) + actionAlwaysShowImage, +#endif -- * Signals actionActivated, @@ -147,7 +151,7 @@ import System.Glib.GList import System.Glib.Attributes import System.Glib.Properties -import System.Glib.GObject (constructNewGObject) +import System.Glib.GObject (wrapNewGObject) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} @@ -174,7 +178,7 @@ -- representing the action -> IO Action actionNew name label tooltip stockId = - constructNewGObject mkAction $ + wrapNewGObject mkAction $ maybeWith withUTFString stockId $ \stockIdPtr -> maybeWith withUTFString tooltip $ \tooltipPtr -> withUTFString label $ \labelPtr -> @@ -500,6 +504,19 @@ actionAccelPath = newAttr actionGetAccelPath actionSetAccelPath +#endif + +#if GTK_CHECK_VERSION(2,20,0) +-- | If 'True', the action's menu item proxies will ignore the 'menuImages' setting and always show +-- their image, if available. +-- +-- Use this property if the menu item would be useless or hard to use without their image. +-- +-- Default value: 'False' +-- +-- Since 2.20 +actionAlwaysShowImage :: ActionClass self => Attr self Bool +actionAlwaysShowImage = newAttrFromBoolProperty "always-show-image" #endif -------------------- diff --git a/Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs b/Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs --- a/Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs +++ b/Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs @@ -113,7 +113,7 @@ import System.Glib.GList import System.Glib.Attributes import System.Glib.Properties -import System.Glib.GObject (constructNewGObject, +import System.Glib.GObject (wrapNewGObject, makeNewGObject, destroyFunPtr) {#import Graphics.UI.Gtk.Types#} import System.Glib.Signals (on) @@ -135,7 +135,7 @@ String -- ^ @name@ - the name of the action group. -> IO ActionGroup actionGroupNew name = - constructNewGObject mkActionGroup $ + wrapNewGObject mkActionGroup $ withUTFString name $ \namePtr -> {# call gtk_action_group_new #} namePtr diff --git a/Graphics/UI/Gtk/ActionMenuToolbar/RadioAction.chs b/Graphics/UI/Gtk/ActionMenuToolbar/RadioAction.chs --- a/Graphics/UI/Gtk/ActionMenuToolbar/RadioAction.chs +++ b/Graphics/UI/Gtk/ActionMenuToolbar/RadioAction.chs @@ -88,7 +88,7 @@ import System.Glib.GList import System.Glib.Attributes import System.Glib.Properties -import System.Glib.GObject (constructNewGObject, makeNewGObject) +import System.Glib.GObject (wrapNewGObject, makeNewGObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.StockItems @@ -114,7 +114,7 @@ -- should return if this action is selected. -> IO RadioAction radioActionNew name label tooltip stockId value = - constructNewGObject mkRadioAction $ + wrapNewGObject mkRadioAction $ maybeWith withUTFString stockId $ \stockIdPtr -> maybeWith withUTFString tooltip $ \tooltipPtr -> withUTFString label $ \labelPtr -> diff --git a/Graphics/UI/Gtk/ActionMenuToolbar/RecentAction.chs b/Graphics/UI/Gtk/ActionMenuToolbar/RecentAction.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/ActionMenuToolbar/RecentAction.chs @@ -0,0 +1,141 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget RecentAction +-- +-- Author : Andy Stewart +-- +-- Created: 24 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- An action of which represents a list of recently used files +-- +-- * Module available since Gtk+ version 2.12 +-- +module Graphics.UI.Gtk.ActionMenuToolbar.RecentAction ( + +-- * Detail +-- +-- | A 'RecentAction' represents a list of recently used files, which can be +-- shown by widgets such as 'RecentChooserDialog' or 'RecentChooserMenu'. +-- +-- To construct a submenu showing recently used files, use a 'RecentAction' +-- as the action for a \. To construct a menu toolbutton showing the +-- recently used files in the popup menu, use a 'RecentAction' as the action +-- for a \ element. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----'Action' +-- | +----RecentAction +-- @ + +#if GTK_CHECK_VERSION(2,12,0) +-- * Types + RecentAction, + RecentActionClass, + castToRecentAction, + toRecentAction, + +-- * Constructors + recentActionNew, + recentActionNewForManager, + +-- * Attributes + recentActionShowNumbers, +#endif + ) where + +import Control.Monad (liftM) +import Data.Maybe (fromMaybe) + +import System.Glib.FFI +import System.Glib.Attributes +import System.Glib.Properties +import System.Glib.UTFString +import System.Glib.GObject (wrapNewGObject) +{#import Graphics.UI.Gtk.Types#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,12,0) +-------------------- +-- Constructors + +-- | Creates a new 'RecentAction' object. To add the action to a 'ActionGroup' +-- and set the accelerator for the action, call +-- 'actionGroupAddActionWithAccel'. +-- +recentActionNew :: + String -- ^ @name@ - a unique name for the action + -> Maybe String -- ^ @label@ - the label displayed in menu items and on buttons, or 'Nothing' + -> Maybe String -- ^ @tooltip@ - a tooltip for the action, or 'Nothing' + -> Maybe String -- ^ @stockId@ - the stock icon to display in widgets representing + -- the action, or 'Nothing' + -> IO RecentAction +recentActionNew name label tooltip stockId = + wrapNewGObject mkRecentAction $ + liftM castPtr $ + withUTFString name $ \namePtr -> + maybeWith withUTFString label $ \labelPtr -> + maybeWith withUTFString tooltip $ \tooltipPtr -> + maybeWith withUTFString stockId $ \stockIdPtr -> + {# call gtk_recent_action_new #} + namePtr + labelPtr + tooltipPtr + stockIdPtr + +-- | Creates a new 'RecentAction' object. To add the action to a 'ActionGroup' +-- and set the accelerator for the action, call +-- 'actionGroupAddActionWithAccel'. +-- +recentActionNewForManager :: RecentManagerClass manager => + String -- ^ @name@ - a unique name for the action + -> Maybe String -- ^ @label@ - the label displayed in menu items and on buttons, + -- or 'Nothing' + -> Maybe String -- ^ @tooltip@ - a tooltip for the action, or 'Nothing' + -> Maybe String -- ^ @stockId@ - the stock icon to display in widgets representing + -- the action, or 'Nothing' + -> Maybe manager -- ^ @manager@ - a 'RecentManager', or 'Nothing' for the + -- default 'RecentManager' + -> IO RecentAction +recentActionNewForManager name label tooltip stockId manager = + wrapNewGObject mkRecentAction $ liftM castPtr $ + withUTFString name $ \namePtr -> + maybeWith withUTFString label $ \labelPtr -> + maybeWith withUTFString tooltip $ \tooltipPtr -> + maybeWith withUTFString stockId $ \stockIdPtr -> do + {# call gtk_recent_action_new_for_manager #} + namePtr + labelPtr + tooltipPtr + stockIdPtr + (maybe (RecentManager nullForeignPtr) toRecentManager manager) + +-------------------- +-- Attributes + +-- | If recent items should be shown with numbers next to them. +-- +recentActionShowNumbers :: RecentActionClass self => Attr self Bool +recentActionShowNumbers = newAttrFromBoolProperty "show-numbers" +#endif diff --git a/Graphics/UI/Gtk/ActionMenuToolbar/ToggleAction.chs b/Graphics/UI/Gtk/ActionMenuToolbar/ToggleAction.chs --- a/Graphics/UI/Gtk/ActionMenuToolbar/ToggleAction.chs +++ b/Graphics/UI/Gtk/ActionMenuToolbar/ToggleAction.chs @@ -83,7 +83,7 @@ import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties -import System.Glib.GObject (constructNewGObject) +import System.Glib.GObject (wrapNewGObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.StockItems @@ -107,7 +107,7 @@ -- representing the action -> IO ToggleAction toggleActionNew name label tooltip stockId = - constructNewGObject mkToggleAction $ + wrapNewGObject mkToggleAction $ maybeWith withUTFString stockId $ \stockIdPtr -> maybeWith withUTFString tooltip $ \tooltipPtr -> withUTFString label $ \labelPtr -> diff --git a/Graphics/UI/Gtk/ActionMenuToolbar/UIManager.chs b/Graphics/UI/Gtk/ActionMenuToolbar/UIManager.chs --- a/Graphics/UI/Gtk/ActionMenuToolbar/UIManager.chs +++ b/Graphics/UI/Gtk/ActionMenuToolbar/UIManager.chs @@ -262,7 +262,7 @@ import System.Glib.GError import System.Glib.Attributes import System.Glib.Properties -import System.Glib.GObject (constructNewGObject, makeNewGObject) +import System.Glib.GObject (wrapNewGObject, makeNewGObject) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} @@ -285,7 +285,7 @@ -- uiManagerNew :: IO UIManager uiManagerNew = - constructNewGObject mkUIManager $ + wrapNewGObject mkUIManager $ {# call gtk_ui_manager_new #} -------------------- @@ -566,14 +566,14 @@ -- 'uiManagerGetWidget'. -- addWidget :: UIManagerClass self => Signal self (Widget -> IO ()) -addWidget = Signal (connect_OBJECT__NONE "add_widget") +addWidget = Signal (connect_OBJECT__NONE "add-widget") -- %hash c:2480 d:366c -- | The \"actions-changed\" signal is emitted whenever the set of actions -- changes. -- actionsChanged :: UIManagerClass self => Signal self (IO ()) -actionsChanged = Signal (connect_NONE__NONE "actions_changed") +actionsChanged = Signal (connect_NONE__NONE "actions-changed") -------------------- -- Deprecated Signals diff --git a/Graphics/UI/Gtk/Builder.chs b/Graphics/UI/Gtk/Builder.chs --- a/Graphics/UI/Gtk/Builder.chs +++ b/Graphics/UI/Gtk/Builder.chs @@ -113,7 +113,7 @@ -- | Creates a new 'Builder' object. builderNew :: IO Builder builderNew = - makeNewObject mkBuilder $ + wrapNewGObject mkBuilder $ {# call unsafe builder_new #} -- | Parses a file containing a GtkBuilder UI definition and merges it with diff --git a/Graphics/UI/Gtk/Buttons/Button.chs b/Graphics/UI/Gtk/Buttons/Button.chs --- a/Graphics/UI/Gtk/Buttons/Button.chs +++ b/Graphics/UI/Gtk/Buttons/Button.chs @@ -93,6 +93,9 @@ buttonSetImagePosition, buttonGetImagePosition, #endif +#if GTK_CHECK_VERSION(2,22,0) + buttonGetEventWindow, +#endif -- * Attributes buttonLabel, @@ -490,6 +493,19 @@ buttonGetImagePosition self = liftM (toEnum . fromIntegral) $ {# call gtk_button_get_image_position #} + (toButton self) +#endif + +#if GTK_CHECK_VERSION(2,22,0) +-- | Returns the button's event window if it is realized, 'Nothing' otherwise. +-- +-- * Available since Gtk+ version 2.22 +-- +buttonGetEventWindow :: ButtonClass self => self + -> IO (Maybe DrawWindow) -- ^ returns button's event window or 'Nothing' +buttonGetEventWindow self = + maybeNull (makeNewGObject mkDrawWindow) $ + {#call gtk_button_get_event_window #} (toButton self) #endif diff --git a/Graphics/UI/Gtk/Buttons/CheckButton.chs b/Graphics/UI/Gtk/Buttons/CheckButton.chs --- a/Graphics/UI/Gtk/Buttons/CheckButton.chs +++ b/Graphics/UI/Gtk/Buttons/CheckButton.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget CheckButton -- diff --git a/Graphics/UI/Gtk/Buttons/LinkButton.chs b/Graphics/UI/Gtk/Buttons/LinkButton.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Buttons/LinkButton.chs @@ -0,0 +1,174 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget LinkButton +-- +-- Author : Andy Stewart +-- +-- Created: 22 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- Create buttons bound to a URL +-- +-- * Module available since Gtk+ version 2.10 +-- +module Graphics.UI.Gtk.Buttons.LinkButton ( + +-- * Detail +-- +-- | A 'LinkButton' is a 'Button' with a hyperlink, similar to the one used by +-- web browsers, which triggers an action when clicked. It is useful to show +-- quick links to resources. +-- +-- A link button is created by calling either 'linkButtonNew' or +-- 'linkButtonNewWithLabel'. If using the former, the URI you pass to the +-- constructor is used as a label for the widget. +-- +-- The URI bound to a 'LinkButton' can be set specifically using +-- \"set linkButton [linkButtonURI := uri]\", and retrieved using \"uri <- get linkButton linkButtonURI\". +-- +-- 'LinkButton' offers a global hook, which is called when the used clicks +-- on it: see 'linkButtonSetURIHook'. +-- +-- 'LinkButton' was added in Gtk+ 2.10. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----'Widget' +-- | +----'Container' +-- | +----'Bin' +-- | +----'Button' +-- | +----LinkButton +-- @ + +#if GTK_CHECK_VERSION(2,10,0) +-- * Types + LinkButton, + LinkButtonClass, + castToLinkButton, + toLinkButton, + +-- * Constructors + linkButtonNew, + linkButtonNewWithLabel, + +-- * Methods + linkButtonSetUriHook, + +-- * Attributes + linkButtonURI, +#if GTK_CHECK_VERSION(2,14,0) + linkButtonVisited, +#endif +#endif + ) where + +import Control.Monad (liftM, unless) + +import System.Glib.FFI +import System.Glib.UTFString +import System.Glib.Attributes +import System.Glib.Properties +import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +{#import Graphics.UI.Gtk.Types#} +{#import Graphics.UI.Gtk.Signals#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,10,0) + +-------------------- +-- Constructors + +-- | Creates a new 'LinkButton' with the URI as its text. +-- +linkButtonNew :: + String -- ^ @uri@ - a valid URI + -> IO LinkButton +linkButtonNew uri = + makeNewObject mkLinkButton $ + liftM (castPtr :: Ptr Widget -> Ptr LinkButton) $ + withUTFString uri $ \uriPtr -> + {# call gtk_link_button_new #} + uriPtr + +-- | Creates a new 'LinkButton' containing a label. +-- +linkButtonNewWithLabel :: + String -- ^ @uri@ - a valid URI + -> String -- ^ @label@ - the text of the button + -> IO LinkButton +linkButtonNewWithLabel uri label = + makeNewObject mkLinkButton $ + liftM (castPtr :: Ptr Widget -> Ptr LinkButton) $ + withUTFString label $ \labelPtr -> + withUTFString uri $ \uriPtr -> + {# call gtk_link_button_new_with_label #} + uriPtr + labelPtr + +-------------------- +-- Methods + +-- | Sets @func@ as the function that should be invoked every time a user +-- clicks a 'LinkButton'. This function is called before every callback +-- registered for the 'buttonClicked' signal. +-- +-- If no uri hook has been set, Gtk+ defaults to calling 'showURI'. +-- +linkButtonSetUriHook :: (String -> IO ()) -> IO () +linkButtonSetUriHook func = do + pfPtr <- mkLinkButtonUriFunc $ \_ cstr _ -> do + str <- peekCString cstr + func str + {# call link_button_set_uri_hook #} pfPtr (castFunPtrToPtr pfPtr) destroyFunPtr + freeHaskellFunPtr pfPtr + +{#pointer LinkButtonUriFunc#} + +foreign import ccall "wrapper" mkLinkButtonUriFunc :: + (Ptr LinkButton -> CString -> Ptr () -> IO ()) + -> IO LinkButtonUriFunc + +-------------------- +-- Attributes + +-- | The URI bound to this button. +-- +-- Default value: \"\" +-- +-- * Available since Gtk+ version 2.10 +-- +linkButtonURI :: LinkButtonClass self => Attr self String +linkButtonURI = newAttrFromStringProperty "uri" + +#if GTK_CHECK_VERSION(2,14,0) +-- | The 'visited' state of this button. A visited link is drawn in a different color. +-- +-- Default value: 'False' +-- +-- * Available since Gtk+ version 2.14 +-- +linkButtonVisited :: LinkButtonClass self => Attr self Bool +linkButtonVisited = newAttrFromBoolProperty "visited" +#endif +#endif diff --git a/Graphics/UI/Gtk/Buttons/ScaleButton.chs b/Graphics/UI/Gtk/Buttons/ScaleButton.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Buttons/ScaleButton.chs @@ -0,0 +1,235 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget ScaleButton +-- +-- Author : Andy Stewart +-- +-- Created: 22 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- A button which pops up a scale +-- +-- * Module available since Gtk+ version 2.12 +-- +module Graphics.UI.Gtk.Buttons.ScaleButton ( + +-- * Detail +-- +-- | 'ScaleButton' provides a button which pops up a scale widget. This kind +-- of widget is commonly used for volume controls in multimedia applications, +-- and Gtk+ provides a 'VolumeButton' subclass that is tailored for this use +-- case. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----'Widget' +-- | +----'Container' +-- | +----'Bin' +-- | +----'Button' +-- | +----ScaleButton +-- | +----'VolumeButton' +-- @ + +#if GTK_CHECK_VERSION(2,12,0) +-- * Types + ScaleButton, + ScaleButtonClass, + castToScaleButton, + toScaleButton, + +-- * Constructors + scaleButtonNew, + +-- * Methods + scaleButtonSetIcons, +#if GTK_CHECK_VERSION(2,14,0) + scaleButtonGetPopup, + scaleButtonGetPlusButton, + scaleButtonGetMinusButton, +#endif + +-- * Attributes + scaleButtonValue, + scaleButtonSize, + scaleButtonAdjustment, + scaleButtonIcons, + +-- * Signals + scaleButtonPopdown, + scaleButtonPopup, + scaleButtonValueChanged, +#endif + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.UTFString +import System.Glib.Attributes +import System.Glib.Properties +import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +import Graphics.UI.Gtk.General.Structs (IconSize(..)) +{#import Graphics.UI.Gtk.Types#} +{#import Graphics.UI.Gtk.Signals#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,12,0) +-------------------- +-- Interfaces + +-- instance OrientableClass ScaleButton + +-------------------- +-- Constructors + +-- | Creates a 'ScaleButton', with a range between @min@ and @max@, with a +-- stepping of @step@. +-- +scaleButtonNew :: + IconSize -- ^ @size@ - a stock icon size + -> Double -- ^ @min@ - the minimum value of the scale (usually 0) + -> Double -- ^ @max@ - the maximum value of the scale (usually 100) + -> Double -- ^ @step@ - the stepping of value when a scroll-wheel event, or + -- up\/down arrow event occurs (usually 2) + -> [String] -- ^ @icons@ + -> IO ScaleButton +scaleButtonNew size min max step icons = + makeNewObject mkScaleButton $ + liftM (castPtr :: Ptr Widget -> Ptr ScaleButton) $ + withUTFStringArray0 icons $ \iconsPtr -> + {# call gtk_scale_button_new #} + ((fromIntegral . fromEnum) size) + (realToFrac min) + (realToFrac max) + (realToFrac step) + iconsPtr + +-------------------- +-- Methods + +-- | Sets the icons to be used by the scale button. For details, see the "icons" property. +scaleButtonSetIcons :: ScaleButtonClass self => self + -> [String] -- ^ @icons@ + -> IO () +scaleButtonSetIcons self icons = + withUTFStringArray0 icons $ \iconsPtr -> + {# call gtk_scale_button_set_icons #} + (toScaleButton self) + iconsPtr + +#if GTK_CHECK_VERSION(2,14,0) +-- | Retrieves the popup of the 'ScaleButton'. +-- +-- * Available since Gtk+ version 2.14 +-- +scaleButtonGetPopup :: ScaleButtonClass self => self + -> IO Widget -- ^ returns the popup of the 'ScaleButton' +scaleButtonGetPopup self = + makeNewObject mkWidget $ + {# call gtk_scale_button_get_popup #} + (toScaleButton self) + +-- | Retrieves the plus button of the 'ScaleButton'. +-- +-- * Available since Gtk+ version 2.14 +-- +scaleButtonGetPlusButton :: ScaleButtonClass self => self + -> IO Widget -- ^ returns the plus button of the 'ScaleButton'. +scaleButtonGetPlusButton self = + makeNewObject mkWidget $ + {# call gtk_scale_button_get_plus_button #} + (toScaleButton self) + +-- | Retrieves the minus button of the 'ScaleButton'. +-- +-- * Available since Gtk+ version 2.14 +-- +scaleButtonGetMinusButton :: ScaleButtonClass self => self + -> IO Widget -- ^ returns the minus button of the 'ScaleButton'. +scaleButtonGetMinusButton self = + makeNewObject mkWidget $ + {# call gtk_scale_button_get_minus_button #} + (toScaleButton self) +#endif + +-------------------- +-- Attributes + +-- | The value of the scale. +-- +-- Default value: 0 +scaleButtonValue :: ScaleButtonClass self => Attr self Double +scaleButtonValue = newAttrFromDoubleProperty "value" + +-- | The icon size. +-- +-- Default value: ''IconSizeSmallToolbar'' +scaleButtonSize :: ScaleButtonClass self => Attr self IconSize +scaleButtonSize = newAttrFromEnumProperty "size" + {# call pure unsafe gtk_icon_size_get_type #} + +-- | The 'Adjustment' that contains the current value of this scale button object. +scaleButtonAdjustment :: ScaleButtonClass self => Attr self Adjustment +scaleButtonAdjustment = newAttrFromObjectProperty "adjustment" + {# call pure unsafe gtk_adjustment_get_type #} + +-- | The names of the icons to be used by the scale button. The first item in the array will be used in +-- the button when the current value is the lowest value, the second item for the highest value. All +-- the subsequent icons will be used for all the other values, spread evenly over the range of values. +-- +-- If there's only one icon name in the icons array, it will be used for all the values. If only two +-- icon names are in the icons array, the first one will be used for the bottom 50% of the scale, and +-- the second one for the top 50%. +-- +-- It is recommended to use at least 3 icons so that the 'ScaleButton' reflects the current value of +-- the scale better for the users. +-- +-- Since 2.12 +scaleButtonIcons :: ScaleButtonClass self => ReadWriteAttr self [String] (Maybe [String]) +scaleButtonIcons = + newAttr (objectGetPropertyBoxedOpaque (peekUTFStringArray0 . castPtr) gtype "search-path") + (objectSetPropertyBoxedOpaque (\dirs f -> maybeWith withUTFStringArray0 dirs (f . castPtr)) gtype "search-path") + where gtype = {#call pure g_strv_get_type#} + + +-------------------- +-- Signals + +-- | The 'scaleButtonValueChanged' signal is emitted when the value field has changed. +-- +scaleButtonValueChanged :: ScaleButtonClass self => Signal self (Double -> IO ()) +scaleButtonValueChanged = Signal (connect_DOUBLE__NONE "value_changed") + +-- | The 'popup' signal is a keybinding signal which gets emitted to popup the scale widget. +-- +-- The default bindings for this signal are Space, Enter and Return. +scaleButtonPopup :: ScaleButtonClass self => Signal self (IO ()) +scaleButtonPopup = Signal (connect_NONE__NONE "popup") + +-- | The 'popdown' signal is a keybinding signal which gets emitted to popdown the scale widget. +-- +-- The default binding for this signal is Escape. +scaleButtonPopdown :: ScaleButtonClass self => Signal self (IO ()) +scaleButtonPopdown = Signal (connect_NONE__NONE "popdown") +#endif diff --git a/Graphics/UI/Gtk/Buttons/VolumeButton.chs b/Graphics/UI/Gtk/Buttons/VolumeButton.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Buttons/VolumeButton.chs @@ -0,0 +1,85 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget VolumeButton +-- +-- Author : Andy Stewart +-- +-- Created: 22 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- A button which pops up a volume control +-- +-- * Module available since Gtk+ version 2.12 +-- +module Graphics.UI.Gtk.Buttons.VolumeButton ( + +-- * Detail +-- +-- | 'VolumeButton' is a subclass of 'ScaleButton' that has been tailored for +-- use as a volume control widget with suitable icons, tooltips and accessible +-- labels. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----'Widget' +-- | +----'Container' +-- | +----'Bin' +-- | +----'Button' +-- | +----'ScaleButton' +-- | +----VolumeButton +-- @ + +#if GTK_CHECK_VERSION(2,12,0) +-- * Types + VolumeButton, + VolumeButtonClass, + castToVolumeButton, + toVolumeButton, + +-- * Constructors + volumeButtonNew, +#endif + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +{#import Graphics.UI.Gtk.Types#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,12,0) +-------------------- +-- Constructors + +-- | Creates a 'VolumeButton', with a range between 0.0 and 1.0, with a +-- stepping of 0.02. Volume values can be obtained and modified using the +-- functions from 'ScaleButton'. +-- +volumeButtonNew :: IO VolumeButton +volumeButtonNew = + makeNewObject mkVolumeButton $ + liftM (castPtr :: Ptr Widget -> Ptr VolumeButton) $ + {# call gtk_volume_button_new #} +#endif diff --git a/Graphics/UI/Gtk/Display/AccelLabel.chs b/Graphics/UI/Gtk/Display/AccelLabel.chs --- a/Graphics/UI/Gtk/Display/AccelLabel.chs +++ b/Graphics/UI/Gtk/Display/AccelLabel.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget AccelLabel -- diff --git a/Graphics/UI/Gtk/Display/InfoBar.chs b/Graphics/UI/Gtk/Display/InfoBar.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Display/InfoBar.chs @@ -0,0 +1,272 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget InfoBar +-- +-- Author : Andy Stewart +-- +-- Created: 27 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- The following varargs functions can't bound: +-- +-- gtk_info_bar_new_with_buttons +-- gtk_info_bar_add_buttons +-- +-- Use 'infoBarAddButton' replace. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- Report important messages to the user +-- +module Graphics.UI.Gtk.Display.InfoBar ( + +-- * Detail +-- +-- | 'InfoBar' is a widget that can be used to show messages to the user +-- without showing a dialog. It is often temporarily shown at the top or bottom +-- of a document. In contrast to 'Dialog', which has a horizontal action area +-- at the bottom, 'InfoBar' has a vertical action area at the side. +-- +-- The API of 'InfoBar' is very similar to 'Dialog', allowing you to add +-- buttons to the action area with 'infoBarAddButton'. +-- The sensitivity of action widgets can be controlled +-- with 'infoBarSetResponseSensitive'. To add widgets to the main content area +-- of a 'InfoBar', use 'infoBarGetContentArea' and add your widgets to the +-- container. +-- +-- Similar to 'MessageDialog', the contents of a 'InfoBar' can by classified +-- as error message, warning, informational message, etc, by using +-- 'infoBarSetMessageType'. Gtk+ uses the message type to determine the +-- background color of the message area. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----'Widget' +-- | +----'Container' +-- | +----'Box' +-- | +----'HBox' +-- | +----InfoBar +-- @ + +#if GTK_CHECK_VERSION(2,18,0) +-- * Types + InfoBar, + InfoBarClass, + castToInfoBar, + toInfoBar, + +-- * Constructors + infoBarNew, + +-- * Methods + infoBarAddActionWidget, + infoBarAddButton, + infoBarSetResponseSensitive, + infoBarSetDefaultResponse, + infoBarEmitResponse, + infoBarGetActionArea, + infoBarGetContentArea, + +-- * Attributes + infoBarMessageType, + +-- * Signals + infoBarResponse, + infoBarClose, +#endif + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.UTFString +import System.Glib.Attributes +import System.Glib.Properties +{#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) +{#import Graphics.UI.Gtk.Windows.MessageDialog#} (MessageType) +{#import Graphics.UI.Gtk.Types#} +{#import Graphics.UI.Gtk.Signals#} + +{# context lib="gtk" prefix="gtk" #} + +-------------------- +-- Interfaces + +-- instance BuildableClass InfoBar + +-------------------- +-- Constructors + +#if GTK_CHECK_VERSION(2,18,0) +-- | Creates a new 'InfoBar' object. +-- +-- * Available since Gtk+ version 2.18 +-- +infoBarNew :: IO InfoBar +infoBarNew = + makeNewObject mkInfoBar $ + liftM (castPtr :: Ptr Widget -> Ptr InfoBar) $ + {# call gtk_info_bar_new #} + +-------------------- +-- Methods + +-- | Add an activatable widget to the action area of a 'InfoBar', connecting a signal handler that will +-- emit the "response" signal on the message area when the widget is activated. The widget is appended +-- to the end of the message areas action area. +-- +-- * Available since Gtk+ version 2.18 +-- +infoBarAddActionWidget :: (InfoBarClass self, WidgetClass child) => self + -> child -- ^ @child@ - an activatable widget + -> Int -- ^ @responseId@ - response ID for @child@ + -> IO () +infoBarAddActionWidget self child responseId = + {# call gtk_info_bar_add_action_widget #} + (toInfoBar self) + (toWidget child) + (fromIntegral responseId) + +-- | Adds a button with the given text (or a stock button, if buttonText is a +-- stock ID) and sets things up so that clicking the button will emit the +-- \"response\" signal with the given responseId. The button is appended to +-- the end of the info bars's action area. The button widget is returned, but +-- usually you don't need it. +-- +-- * Available since Gtk+ version 2.18 +-- +infoBarAddButton :: InfoBarClass self => self + -> String -- ^ @buttonText@ - text of button, or stock ID + -> Int -- ^ @responseId@ - response ID for the button + -> IO Button -- ^ returns the button widget that was added +infoBarAddButton self buttonText responseId = + makeNewObject mkButton $ + withUTFString buttonText $ \buttonTextPtr -> + liftM (castPtr :: Ptr Widget -> Ptr Button) $ + {# call gtk_info_bar_add_button #} + (toInfoBar self) + buttonTextPtr + (fromIntegral responseId) + +-- | Calls 'widgetSetSensitive' for each widget in the +-- info bars's action area with the given responseId. A convenient way to +-- sensitize\/desensitize dialog buttons. +-- +-- * Available since Gtk+ version 2.18 +-- +infoBarSetResponseSensitive :: InfoBarClass self => self + -> Int -- ^ @responseId@ - a response ID + -> Bool -- ^ @setting@ - @True@ for sensitive + -> IO () +infoBarSetResponseSensitive self responseId setting = + {# call gtk_info_bar_set_response_sensitive #} + (toInfoBar self) + (fromIntegral responseId) + (fromBool setting) + +-- | Sets the last widget in the info bar's action area with the given +-- responseId as the default widget for the dialog. Pressing \"Enter\" +-- normally activates the default widget. +-- +-- * Available since Gtk+ version 2.18 +-- +infoBarSetDefaultResponse :: InfoBarClass self => self + -> Int -- ^ @responseId@ - a response ID + -> IO () +infoBarSetDefaultResponse self responseId = + {# call gtk_info_bar_set_default_response #} + (toInfoBar self) + (fromIntegral responseId) + +-- | Emits the \'response\' signal with the given @responseId@. +-- +-- * Available since Gtk+ version 2.18 +-- +infoBarEmitResponse :: InfoBarClass self => self + -> Int -- ^ @responseId@ - a response ID + -> IO () +infoBarEmitResponse self responseId = + {# call gtk_info_bar_response #} + (toInfoBar self) + (fromIntegral responseId) + +-- | Returns the action area of @infoBar@. +-- +-- * Available since Gtk+ version 2.18 +-- +infoBarGetActionArea :: InfoBarClass self => self + -> IO Widget -- ^ returns the action area. +infoBarGetActionArea self = + makeNewObject mkWidget $ + {# call gtk_info_bar_get_action_area #} + (toInfoBar self) + +-- | Returns the content area of @infoBar@. +-- +-- * Available since Gtk+ version 2.18 +-- +infoBarGetContentArea :: InfoBarClass self => self + -> IO Widget -- ^ returns the content area. +infoBarGetContentArea self = + makeNewObject mkWidget $ + {# call gtk_info_bar_get_content_area #} + (toInfoBar self) + +-------------------- +-- Attributes + +-- | The type of the message. +-- +-- The type is used to determine the colors to use in the info bar. +-- +-- If the type is 'MessageOther', no info bar is painted but the colors are still set. +-- +-- Default value: 'MessageInfo' +-- +-- * Available since Gtk+ version 2.18 +-- +infoBarMessageType :: InfoBarClass self => Attr self MessageType +infoBarMessageType = newAttrFromEnumProperty "message-type" + {# call pure unsafe gtk_message_type_get_type #} + +-------------------- +-- Signals + +-- | The 'close' signal is a keybinding signal which gets emitted when the user uses a keybinding to +-- dismiss the info bar. +-- +-- The default binding for this signal is the Escape key. +-- +-- Since 2.18 +infoBarClose :: InfoBarClass self => Signal self (IO ()) +infoBarClose = Signal (connect_NONE__NONE "close") + + +-- | Emitted when an action widget is clicked or the application programmer +-- calls 'dialogResponse'. The @responseId@ depends on which action widget was +-- clicked. +-- +-- * Available since Gtk+ version 2.18 +-- +infoBarResponse :: InfoBarClass self => Signal self (Int -> IO ()) +infoBarResponse = Signal (connect_INT__NONE "response") +#endif + diff --git a/Graphics/UI/Gtk/Display/Spinner.chs b/Graphics/UI/Gtk/Display/Spinner.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Display/Spinner.chs @@ -0,0 +1,99 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget Spinner +-- +-- Author : Andy Stewart +-- +-- Created: 17 Aug 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- Report messages of minor importance to the user +-- +module Graphics.UI.Gtk.Display.Spinner ( +#if GTK_CHECK_VERSION(2,20,0) +-- * Detail +-- +-- | A 'Spinner' widget displays an icon-size spinning animation. It is often used as an alternative to +-- a 'ProgressBar' for displaying indefinite activity, instead of actual progress. +-- +-- To start the animation, use 'spinnerStart'. + +-- * Types + Spinner, + SpinnerClass, + +-- * Constructors + spinnerNew, + +-- * Methods + spinnerStart, + spinnerStop, + +-- * Attributes + spinnerActive, +#endif +) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.UTFString +import System.Glib.Attributes +import System.Glib.Properties +import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +{#import Graphics.UI.Gtk.Types#} +{#import Graphics.UI.Gtk.Signals#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,20,0) +-------------------- +-- Constructors + +-- | Returns a new spinner widget. Not yet started. +spinnerNew :: IO Spinner +spinnerNew = + makeNewObject mkSpinner $ + liftM (castPtr :: Ptr Widget -> Ptr Spinner) $ + {# call unsafe spinner_new #} + +-------------------- +-- Methods + +-- | Starts the animation of the spinner. +spinnerStart :: SpinnerClass spinner => spinner -> IO () +spinnerStart spinner = + {#call spinner_start #} + (toSpinner spinner) + +-- | Stops the animation of the spinner. +spinnerStop :: SpinnerClass spinner => spinner -> IO () +spinnerStop spinner = + {#call spinner_stop #} + (toSpinner spinner) + +-------------------- +-- Attributes + +-- | Whether the spinner is active. +-- +-- Default value: 'False' +spinnerActive :: SpinnerClass spinner => Attr spinner Bool +spinnerActive = newAttrFromBoolProperty "active" +#endif diff --git a/Graphics/UI/Gtk/Display/StatusIcon.chs b/Graphics/UI/Gtk/Display/StatusIcon.chs --- a/Graphics/UI/Gtk/Display/StatusIcon.chs +++ b/Graphics/UI/Gtk/Display/StatusIcon.chs @@ -2,11 +2,12 @@ -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget StatusIcon -- --- Author : Andrea Vezzosi +-- Author : Andrea Vezzosi, Andy Stewart -- -- Created: 19 July 2007 -- -- Copyright (C) 2007 Axel Simon +-- Copyright (C) 2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public @@ -93,6 +94,9 @@ statusIconIsEmbedded, statusIconPositionMenu, statusIconGetGeometry, +#if GTK_CHECK_VERSION(2,20,0) + statusIconSetName, +#endif -- * Attributes statusIconPixbuf, @@ -127,7 +131,7 @@ import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties -import System.Glib.GObject (constructNewGObject,makeNewGObject) +import System.Glib.GObject (wrapNewGObject,makeNewGObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.General.Enums#} import Graphics.UI.Gtk.General.Structs @@ -148,7 +152,7 @@ -- statusIconNew :: IO StatusIcon statusIconNew = - constructNewGObject mkStatusIcon $ + wrapNewGObject mkStatusIcon $ {# call gtk_status_icon_new #} -- %hash c:3318 d:cd70 @@ -161,7 +165,7 @@ Pixbuf -- ^ @pixbuf@ - a 'Pixbuf' -> IO StatusIcon statusIconNewFromPixbuf pixbuf = - constructNewGObject mkStatusIcon $ + wrapNewGObject mkStatusIcon $ {# call gtk_status_icon_new_from_pixbuf #} pixbuf @@ -175,7 +179,7 @@ String -- ^ @filename@ - a filename -> IO StatusIcon statusIconNewFromFile filename = - constructNewGObject mkStatusIcon $ + wrapNewGObject mkStatusIcon $ withUTFString filename $ \filenamePtr -> {# call gtk_status_icon_new_from_file #} filenamePtr @@ -190,7 +194,7 @@ StockId -- ^ @stockId@ - a stock icon id -> IO StatusIcon statusIconNewFromStock stockId = - constructNewGObject mkStatusIcon $ + wrapNewGObject mkStatusIcon $ withUTFString stockId $ \stockIdPtr -> {# call gtk_status_icon_new_from_stock #} stockIdPtr @@ -203,7 +207,7 @@ String -- ^ @iconName@ - an icon name -> IO StatusIcon statusIconNewFromIconName iconName = - constructNewGObject mkStatusIcon $ + wrapNewGObject mkStatusIcon $ withUTFString iconName $ \iconNamePtr -> {# call gtk_status_icon_new_from_icon_name #} iconNamePtr @@ -323,7 +327,7 @@ -- %hash c:b1db d:b874 -- | Gets the size in pixels that is available for the image. Stock icons and -- named icons adapt their size automatically if the size of the notification --- area changes. For other storage types, the size-changed signal can be used +-- area changes. For other storage types, the 'sizeChanged' signal can be used -- to react to size changes. -- statusIconGetSize :: StatusIconClass self => self @@ -454,6 +458,16 @@ return $ Just (rec_,toEnum $ fromIntegral or) else return Nothing +#if GTK_CHECK_VERSION(2,20,0) +-- | Sets the name of this tray icon. This should be a string identifying this icon. It is may be used +-- for sorting the icons in the tray and will not be shown to the user. +statusIconSetName :: StatusIconClass self => self -> String -> IO () +statusIconSetName self name = + withUTFString name $ \ namePtr -> + {#call gtk_status_icon_set_name #} + (toStatusIcon self) + namePtr +#endif -------------------- -- Attributes @@ -532,7 +546,7 @@ -- the notification area got resized. -- statusIconSizeChanged :: StatusIconClass self => Signal self (Int -> IO Bool) -statusIconSizeChanged = Signal (connect_INT__BOOL "size_changed") +statusIconSizeChanged = Signal (connect_INT__BOOL "size-changed") -- | Gets emitted when the user activates the status icon. -- If and how status icons can activated is platform-dependent. diff --git a/Graphics/UI/Gtk/Display/Statusbar.chs b/Graphics/UI/Gtk/Display/Statusbar.chs --- a/Graphics/UI/Gtk/Display/Statusbar.chs +++ b/Graphics/UI/Gtk/Display/Statusbar.chs @@ -2,11 +2,12 @@ -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Statusbar -- --- Author : Axel Simon +-- Author : Axel Simon, Andy Stewart -- -- Created: 23 May 2001 -- -- Copyright (C) 1999-2005 Axel Simon +-- Copyright (C) 2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public @@ -84,6 +85,12 @@ statusbarRemove, statusbarSetHasResizeGrip, statusbarGetHasResizeGrip, +#if GTK_CHECK_VERSION(2,20,0) + statusbarGetMessageArea, +#endif +#if GTK_CHECK_VERSION(2,22,0) + statusbarRemoveAll, +#endif -- * Attributes statusbarHasResizeGrip, @@ -202,6 +209,31 @@ {# call unsafe statusbar_get_has_resize_grip #} (toStatusbar self) +#if GTK_CHECK_VERSION(2,20,0) +-- | Retrieves the box containing the label widget. +statusbarGetMessageArea :: StatusbarClass self => self -> IO Box +statusbarGetMessageArea self = + makeNewObject mkBox $ + liftM (castPtr :: Ptr Widget -> Ptr Box) $ + {# call unsafe gtk_statusbar_get_message_area #} + (toStatusbar self) + +#endif + +#if GTK_CHECK_VERSION(2,22,0) +-- | Forces the removal of all messages from a statusbar's stack with the exact @contextId@. +-- +-- * Available since Gtk+ version 2.22 +-- +statusbarRemoveAll :: StatusbarClass self => self + -> Int -- ^ @contextId@ a context identifier + -> IO () +statusbarRemoveAll self contextId = + {#call gtk_statusbar_remove_all #} + (toStatusbar self) + (fromIntegral contextId) +#endif + -------------------- -- Attributes @@ -221,13 +253,13 @@ -- | Is emitted whenever a new message gets pushed onto a statusbar's stack. -- textPushed :: StatusbarClass self => Signal self (ContextId -> String -> IO ()) -textPushed = Signal (\a self user -> connect_WORD_STRING__NONE "text_pushed" a self (\w s -> user (fromIntegral w) s)) +textPushed = Signal (\a self user -> connect_WORD_STRING__NONE "text-pushed" a self (\w s -> user (fromIntegral w) s)) -- %hash c:2614 d:c1d2 -- | Is emitted whenever a new message is popped off a statusbar's stack. -- textPopped :: StatusbarClass self => Signal self (ContextId -> String -> IO ()) -textPopped = Signal (\a self user -> connect_WORD_STRING__NONE "text_popped" a self (\w s -> user (fromIntegral w) s)) +textPopped = Signal (\a self user -> connect_WORD_STRING__NONE "text-popped" a self (\w s -> user (fromIntegral w) s)) -------------------- -- Deprecated Signals diff --git a/Graphics/UI/Gtk/Entry/Editable.chs b/Graphics/UI/Gtk/Entry/Editable.chs --- a/Graphics/UI/Gtk/Entry/Editable.chs +++ b/Graphics/UI/Gtk/Entry/Editable.chs @@ -69,14 +69,21 @@ editableEditable, -- * Signals + editableChanged, + deleteText, + insertText, + stopDeleteText, + stopInsertText, + +-- * Deprecated +#ifndef DISABLE_DEPRECATED onEditableChanged, afterEditableChanged, onDeleteText, afterDeleteText, - stopDeleteText, onInsertText, - afterInsertText, - stopInsertText + afterInsertText +#endif ) where import Control.Monad (liftM) @@ -277,34 +284,30 @@ -------------------- -- Signals --- | The 'onEditableChanged' signal is emitted at the end of a single +-- | The 'editableChanged' signal is emitted at the end of a single -- user-visible operation on the contents of the 'Editable'. -- -- * For inctance, a paste operation that replaces the contents of the -- selection will cause only one signal emission (even though it is -- implemented by first deleting the selection, then inserting the new --- content, and may cause multiple 'onEditableInserText' signals to be +-- content, and may cause multiple 'inserText' signals to be -- emitted). -- -onEditableChanged, afterEditableChanged :: EditableClass ec => ec -> IO () -> - IO (ConnectId ec) -onEditableChanged = connect_NONE__NONE "changed" False -afterEditableChanged = connect_NONE__NONE "changed" True +editableChanged :: EditableClass ec => Signal ec (IO ()) +editableChanged = Signal (connect_NONE__NONE "changed") -- | Emitted when a piece of text is deleted from the 'Editable' widget. -- --- * See 'onInsertText' for information on how to use this signal. +-- * See 'insertText' for information on how to use this signal. -- -onDeleteText, afterDeleteText :: EditableClass self => self - -> (Int -> Int -> IO ()) -- ^ @(\startPos endPos -> ...)@ - -> IO (ConnectId self) -onDeleteText = connect_INT_INT__NONE "delete_text" False -afterDeleteText = connect_INT_INT__NONE "delete_text" True +deleteText :: EditableClass self + => Signal self (Int -> Int -> IO ()) -- ^ @(\startPos endPos -> ...)@ +deleteText = Signal (connect_INT_INT__NONE "delete-text") -- | Stop the current signal that deletes text. stopDeleteText :: EditableClass self => ConnectId self -> IO () stopDeleteText (ConnectId _ obj) = - signalStopEmission obj "delete_text" + signalStopEmission obj "delete-text" -- | Emitted when a piece of text is inserted into the 'Editable' widget. -- @@ -324,7 +327,7 @@ -- The following code is an example of how to turn all input into uppercase: -- -- > idRef <- newIORef undefined --- > id <- onInsertText entry $ \str pos -> do +-- > id <- entry `on` insertText $ \str pos -> do -- > id <- readIORef idRef -- > signalBlock id -- > pos' <- editableInsertText entry (map toUpper str) pos @@ -333,9 +336,40 @@ -- > return pos' -- > writeIORef idRef id -- --- Note that the 'afterInsertText' function is not very useful, except to +-- Note that binding 'insertText' using 'after' is not very useful, except to -- track editing actions. -- +insertText :: EditableClass self => Signal self (String -> Int -> IO Int) +insertText = Signal $ \after obj handler -> + connect_PTR_INT_PTR__NONE "insert-text" after obj + (\strPtr strLen posPtr -> do + str <- if strLen<0 then peekUTFString strPtr + else peekUTFStringLen (strPtr, strLen) + pos <- peek (posPtr :: Ptr {#type gint#}) + pos' <- handler str (fromIntegral pos) + poke (posPtr :: Ptr {#type gint#}) (fromIntegral pos') + ) + +-- | Stop the current signal that inserts text. +stopInsertText :: EditableClass self => ConnectId self -> IO () +stopInsertText (ConnectId _ obj) = + signalStopEmission obj "insert-text" + +#ifndef DISABLE_DEPRECATED +-------------------- +-- Deprecated Signals + +onEditableChanged, afterEditableChanged :: EditableClass ec => ec -> IO () -> + IO (ConnectId ec) +onEditableChanged = connect_NONE__NONE "changed" False +afterEditableChanged = connect_NONE__NONE "changed" True + +onDeleteText, afterDeleteText :: EditableClass self => self + -> (Int -> Int -> IO ()) -- ^ @(\startPos endPos -> ...)@ + -> IO (ConnectId self) +onDeleteText = connect_INT_INT__NONE "delete_text" False +afterDeleteText = connect_INT_INT__NONE "delete_text" True + onInsertText, afterInsertText :: EditableClass self => self -> (String -> Int -> IO Int) -> IO (ConnectId self) @@ -357,8 +391,4 @@ pos' <- handler str (fromIntegral pos) poke (posPtr :: Ptr {#type gint#}) (fromIntegral pos') ) - --- | Stop the current signal that inserts text. -stopInsertText :: EditableClass self => ConnectId self -> IO () -stopInsertText (ConnectId _ obj) = - signalStopEmission obj "insert_text" +#endif diff --git a/Graphics/UI/Gtk/Entry/Entry.chs b/Graphics/UI/Gtk/Entry/Entry.chs --- a/Graphics/UI/Gtk/Entry/Entry.chs +++ b/Graphics/UI/Gtk/Entry/Entry.chs @@ -2,11 +2,12 @@ -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Entry -- --- Author : Axel Simon +-- Author : Axel Simon, Andy Stewart -- -- Created: 23 May 2001 -- -- Copyright (C) 1999-2005 Axel Simon +-- Copyright (C) 2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public @@ -18,13 +19,6 @@ -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details. -- --- 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. --- I removed onInsertAtCursor since it is internal and not emitted. The usable funtions --- are in Editable. --- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional @@ -84,6 +78,14 @@ entrySetCompletion, entryGetCompletion, #endif +#if GTK_CHECK_VERSION(2,20,0) + entryGetIconWindow, + entryGetTextWindow, +#endif +#if GTK_CHECK_VERSION(2,22,0) + entryImContextFilterKeypress, + entryResetImContext, +#endif -- * Attributes entryCursorPosition, @@ -104,6 +106,26 @@ #endif -- * Signals + entryActivate, + entryBackspace, + entryCopyClipboard, + entryCutClipboard, + entryPasteClipboard, + entryDeleteFromCursor, + entryInsertAtCursor, + entryMoveCursor, + entryPopulatePopup, + entryToggleOverwirte, +#if GTK_CHECK_VERSION(2,20,0) + entryPreeditChanged, +#endif +#if GTK_CHECK_VERSION(2,16,0) + entryIconPress, + entryIconRelease, +#endif + +-- * Deprecated +#ifndef DISABLE_DEPRECATED onEntryActivate, afterEntryActivate, onCopyClipboard, @@ -114,9 +136,11 @@ afterPasteClipboard, onToggleOverwrite, afterToggleOverwrite, +#endif ) where import Control.Monad (liftM) +import Control.Monad.Reader (runReaderT) import Data.Char (ord, chr) import System.Glib.FFI @@ -125,6 +149,10 @@ import System.Glib.Properties import System.Glib.GObject (makeNewGObject) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +import Graphics.UI.Gtk.General.Enums (DeleteType (..), MovementStep (..), EntryIconPosition (..)) +import Graphics.UI.Gtk.Gdk.EventM (EventM, EButton, EKey) +import Control.Monad.Reader ( ask ) +import Control.Monad.Trans ( liftIO ) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} @@ -397,6 +425,66 @@ (toEntry self) #endif +#if GTK_CHECK_VERSION(2,20,0) +-- | Returns the 'Window' which contains the entry's icon at @iconPos@. This function is useful when +-- drawing something to the entry in an 'eventExpose' callback because it enables the callback to +-- distinguish between the text window and entry's icon windows. +-- +-- See also 'entryGetTextWindow'. +entryGetIconWindow :: EntryClass self => self + -> EntryIconPosition -- ^ @iconPos@ Icon position + -> IO DrawWindow -- ^ returns the entry's icon window at @iconPos@. +entryGetIconWindow entry iconPos = + makeNewGObject mkDrawWindow $ + {#call gtk_entry_get_icon_window #} + (toEntry entry) + ((fromIntegral . fromEnum) iconPos) + +-- | Returns the 'Window' which contains the text. This function is useful when drawing something to the +-- entry in an 'eventExpose' callback because it enables the callback to distinguish between the text +-- window and entry's icon windows. +-- +-- See also 'entryGetIconWindow'. +entryGetTextWindow :: EntryClass self => self + -> IO DrawWindow -- ^ returns the entry's text window. +entryGetTextWindow entry = + makeNewGObject mkDrawWindow $ + {#call gtk_entry_get_text_window #} + (toEntry entry) +#endif + +#if GTK_CHECK_VERSION(2,22,0) +-- | Allow the 'Entry' input method to internally handle key press and release events. If this function +-- returns 'True', then no further processing should be done for this key event. See +-- 'imContextFilterKeypress'. +-- +-- Note that you are expected to call this function from your handler when overriding key event +-- handling. This is needed in the case when you need to insert your own key handling between the input +-- method and the default key event handling of the 'Entry'. See 'textViewResetImContext' for +-- an example of use. +-- +-- * Available since Gtk+ version 2.22 +-- +entryImContextFilterKeypress :: EntryClass self => self -> EventM EKey Bool +entryImContextFilterKeypress self = do + ptr <- ask + liftIO $ liftM toBool $ + {# call gtk_entry_im_context_filter_keypress #} + (toEntry self) + (castPtr ptr) + +-- | Reset the input method context of the entry if needed. +-- +-- This can be necessary in the case where modifying the buffer would confuse on-going input method +-- behavior. +-- +-- * Available since Gtk+ version 2.22 +-- +entryResetImContext :: EntryClass self => self -> IO () +entryResetImContext self = + {#call gtk_entry_reset_im_context #} (toEntry self) +#endif + -------------------- -- Attributes @@ -534,6 +622,112 @@ -------------------- -- Signals +-- | A keybinding signal which gets emitted when the user activates the entry. +-- +-- Applications should not connect to it, but may emit it with 'signalEmitByName' if they need to +-- control activation programmatically. +entryActivate :: EntryClass ec => Signal ec (IO ()) +entryActivate = Signal (connect_NONE__NONE "activate") + +-- | The 'entryBackspace' signal is a keybinding signal which gets emitted when the user asks for it. +-- +-- The default bindings for this signal are Backspace and Shift-Backspace. +entryBackspace :: EntryClass ec => Signal ec (IO ()) +entryBackspace = Signal (connect_NONE__NONE "backspace") + +-- | The 'entryCopyClipboard' signal is a keybinding signal which gets emitted to copy the selection to the +-- clipboard. +-- +-- The default bindings for this signal are Ctrl-c and Ctrl-Insert. +entryCopyClipboard :: EntryClass ec => Signal ec (IO ()) +entryCopyClipboard = Signal (connect_NONE__NONE "copy-clipboard") + +-- | The 'entryCutClipboard' signal is a keybinding signal which gets emitted to cut the selection to the +-- clipboard. +-- +-- The default bindings for this signal are Ctrl-x and Shift-Delete. +entryCutClipboard :: EntryClass ec => Signal ec (IO ()) +entryCutClipboard = Signal (connect_NONE__NONE "cut-clipboard") + +-- | The 'entryDeleteFromCursor' signal is a keybinding signal which gets emitted when the user initiates a +-- text deletion. +-- +-- If the type is 'DeleteChars', GTK+ deletes the selection if there is one, otherwise it deletes +-- the requested number of characters. +-- +-- The default bindings for this signal are Delete for deleting a character and Ctrl-Delete for +-- deleting a word. +entryDeleteFromCursor :: EntryClass ec => Signal ec (DeleteType -> Int -> IO ()) +entryDeleteFromCursor = Signal (connect_ENUM_INT__NONE "delete-from-cursor") + +-- | The 'entryInsertAtCursor' signal is a keybinding signal which gets emitted when the user initiates the +-- insertion of a fixed string at the cursor. +entryInsertAtCursor :: EntryClass ec => Signal ec (String -> IO ()) +entryInsertAtCursor = Signal (connect_STRING__NONE "insert-at-cursor") + +-- | The 'entryMoveCursor' signal is a keybinding signal which gets emitted when the user initiates a cursor +-- movement. If the cursor is not visible in entry, this signal causes the viewport to be moved +-- instead. +-- +-- Applications should not connect to it, but may emit it with 'signalEmitByName' if they need to +-- control the cursor programmatically. +-- +-- The default bindings for this signal come in two variants, the variant with the Shift modifier +-- extends the selection, the variant without the Shift modifer does not. There are too many key +-- combinations to list them all here. +-- +-- * Arrow keys move by individual characters\/lines +-- * Ctrl-arrow key combinations move by words\/paragraphs +-- * Home\/End keys move to the ends of the buffer +entryMoveCursor :: EntryClass ec => Signal ec (MovementStep -> Int -> Bool -> IO ()) +entryMoveCursor = Signal (connect_ENUM_INT_BOOL__NONE "move-cursor") + +-- | The 'entryPasteClipboard' signal is a keybinding signal which gets emitted to paste the contents of the +-- clipboard into the text view. +-- +-- The default bindings for this signal are Ctrl-v and Shift-Insert. +entryPasteClipboard :: EntryClass ec => Signal ec (IO ()) +entryPasteClipboard = Signal (connect_NONE__NONE "paste-clipboard") + +-- | The 'entryPopulatePopup' signal gets emitted before showing the context menu of the entry. +-- +-- If you need to add items to the context menu, connect to this signal and append your menuitems to +-- the menu. +entryPopulatePopup :: EntryClass ec => Signal ec (Menu -> IO ()) +entryPopulatePopup = Signal (connect_OBJECT__NONE "populate-popup") + +#if GTK_CHECK_VERSION(2,20,0) +-- | If an input method is used, the typed text will not immediately be committed to the buffer. So if +-- you are interested in the text, connect to this signal. +entryPreeditChanged :: EntryClass ec => Signal ec (String -> IO ()) +entryPreeditChanged = Signal (connect_STRING__NONE "preedit-changed") +#endif + +#if GTK_CHECK_VERSION(2,16,0) +-- | The 'iconPress' signal is emitted when an activatable icon is clicked. +-- +entryIconPress :: EntryClass ec => + Signal ec (EntryIconPosition -> EventM EButton ()) +entryIconPress = Signal $ \after obj f -> + connect_ENUM_PTR__NONE "icon-press" after obj (runReaderT . f) + +-- | The 'iconRelease' signal is emitted on the button release from a mouse click over an activatable +-- icon. +-- +entryIconRelease :: EntryClass ec => + Signal ec (EntryIconPosition -> EventM EButton ()) +entryIconRelease = Signal $ \after obj f -> + connect_ENUM_PTR__NONE "icon-press" after obj (runReaderT . f) +#endif + +-- | The 'entryToggleOverwrite' signal is a keybinding signal which gets emitted to toggle the overwrite mode +-- of the entry. +-- +-- The default bindings for this signal is Insert. +entryToggleOverwirte :: EntryClass ec => Signal ec (IO ()) +entryToggleOverwirte = Signal (connect_NONE__NONE "toggle-overwrite") + +#ifndef DISABLE_DEPRECATED -- | Emitted when the user presses return within -- the 'Entry' field. -- @@ -589,3 +783,4 @@ IO (ConnectId ec) onToggleOverwrite = connect_NONE__NONE "toggle_overwrite" False afterToggleOverwrite = connect_NONE__NONE "toggle_overwrite" True +#endif diff --git a/Graphics/UI/Gtk/Entry/EntryBuffer.chs b/Graphics/UI/Gtk/Entry/EntryBuffer.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Entry/EntryBuffer.chs @@ -0,0 +1,248 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget EntryBuffer +-- +-- Author : Andy Stewart +-- +-- Created: 22 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- Text buffer for 'Entry' +-- +-- * Module available since Gtk+ version 2.18 +-- +module Graphics.UI.Gtk.Entry.EntryBuffer ( + +-- * Detail +-- +-- | The 'EntryBuffer' class contains the actual text displayed in a 'Entry' +-- widget. +-- +-- A single 'EntryBuffer' object can be shared by multiple 'Entry' widgets +-- which will then share the same text content, but not the cursor position, +-- visibility attributes, icon etc. +-- +-- 'EntryBuffer' may be derived from. Such a derived class might allow text +-- to be stored in an alternate location, such as non-pageable memory, useful +-- in the case of important passwords. Or a derived class could integrate with +-- an application's concept of undo\/redo. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----EntryBuffer +-- @ + +#if GTK_CHECK_VERSION(2,18,0) +-- * Types + EntryBuffer, + EntryBufferClass, + castToEntryBuffer, + toEntryBuffer, + +-- * Constructors + entryBufferNew, + +-- * Methods + entryBufferGetBytes, + entryBufferInsertText, + entryBufferDeleteText, + entryBufferEmitDeletedText, + entryBufferEmitInsertedText, + +-- * Attributes + entryBufferText, + entryBufferLength, + entryBufferMaxLength, + +-- * Signals + entryBufferInsertedText, + entryBufferDeletedText, +#endif + ) where + +import Control.Monad (liftM) +import Data.Maybe (fromJust) + +import System.Glib.FFI +import System.Glib.UTFString +import System.Glib.Attributes +import System.Glib.Properties +{#import Graphics.UI.Gtk.Types#} +{#import Graphics.UI.Gtk.Signals#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,18,0) +-------------------- +-- Constructors + +-- | Create a new 'EntryBuffer' object. +-- +-- Optionally, specify initial text to set in the buffer. +-- +-- * Available since Gtk+ version 2.18 +-- +entryBufferNew :: + Maybe String -- ^ @initialChars@ - initial buffer text or 'Nothing' + -> IO EntryBuffer +entryBufferNew initialChars = + wrapNewGObject mkEntryBuffer $ + maybeWith withUTFString initialChars $ \initialCharsPtr -> do + let chars = if initialCharsPtr == nullPtr + then (-1) + else length $ fromJust initialChars + {# call gtk_entry_buffer_new #} + initialCharsPtr + (fromIntegral chars) + +-------------------- +-- Methods + +-- | Retrieves the length in bytes of the buffer. See 'entryBufferGetLength'. +-- +-- * Available since Gtk+ version 2.18 +-- +entryBufferGetBytes :: EntryBufferClass self => self + -> IO Int -- ^ returns The byte length of the buffer. +entryBufferGetBytes self = + liftM fromIntegral $ + {# call gtk_entry_buffer_get_bytes #} + (toEntryBuffer self) + +-- | Inserts @chars@ into the contents of the buffer, +-- at position @position@. +-- +-- * Available since Gtk+ version 2.18 +-- +entryBufferInsertText :: EntryBufferClass self => self + -> Int -- ^ @position@ - the position at which to insert text. + -> String -- ^ @chars@ - the text to insert into the buffer. + -> IO Int -- ^ returns The number of characters actually inserted. +entryBufferInsertText self position chars = + liftM fromIntegral $ + withUTFStringLen chars $ \ (charsPtr, len) -> + {# call gtk_entry_buffer_insert_text #} + (toEntryBuffer self) + (fromIntegral position) + charsPtr + (fromIntegral len) + +-- | Deletes a sequence of characters from the buffer. @nChars@ characters are +-- deleted starting at @position@. If @nChars@ is negative, then all characters +-- until the end of the text are deleted. +-- +-- * Available since Gtk+ version 2.18 +-- +entryBufferDeleteText :: EntryBufferClass self => self + -> Int -- ^ @position@ - position at which to delete text + -> Int -- ^ @nChars@ - number of characters to delete + -> IO Int -- ^ returns The number of characters deleted. +entryBufferDeleteText self position nChars = + liftM fromIntegral $ + {# call gtk_entry_buffer_delete_text #} + (toEntryBuffer self) + (fromIntegral position) + (fromIntegral nChars) + +-- | Used when subclassing 'EntryBuffer' +-- +-- * Available since Gtk+ version 2.18 +-- +entryBufferEmitDeletedText :: EntryBufferClass self => self + -> Int -- ^ @position@ - position at which text was deleted + -> Int -- ^ @nChars@ - number of characters deleted + -> IO () +entryBufferEmitDeletedText self position nChars = + {# call gtk_entry_buffer_emit_deleted_text #} + (toEntryBuffer self) + (fromIntegral position) + (fromIntegral nChars) + +-- | Used when subclassing 'EntryBuffer' +-- +-- * Available since Gtk+ version 2.18 +-- +entryBufferEmitInsertedText :: EntryBufferClass self => self + -> Int -- ^ @position@ - position at which text was inserted + -> String -- ^ @chars@ - text that was inserted + -> Int -- ^ @nChars@ - number of characters inserted + -> IO () +entryBufferEmitInsertedText self position chars nChars = + withUTFString chars $ \charsPtr -> + {# call gtk_entry_buffer_emit_inserted_text #} + (toEntryBuffer self) + (fromIntegral position) + charsPtr + (fromIntegral nChars) + +-------------------- +-- Attributes + +-- | The contents of the buffer. +-- +-- Default value: \"\" +-- +-- * Available since Gtk+ version 2.18 +-- +entryBufferText :: EntryBufferClass self => Attr self String +entryBufferText = newAttrFromStringProperty "text" + +-- | The length of the text in buffer. +-- +-- Allowed values: <= 65535 +-- +-- Default value: 0 +-- +-- * Available since Gtk+ version 2.18 +-- +entryBufferLength :: EntryBufferClass self => ReadAttr self Int +entryBufferLength = readAttrFromIntProperty "length" + +-- | The maximum length of the text in the buffer. +-- +-- Allowed values: [0,65535] +-- +-- Default value: 0 +-- +-- * Available since Gtk+ version 2.18 +-- +entryBufferMaxLength :: EntryBufferClass self => Attr self Int +entryBufferMaxLength = newAttrFromIntProperty "max-length" + +-------------------- +-- Signals + +-- | +-- +-- * Available since Gtk+ version 2.18 +-- +entryBufferInsertedText :: EntryBufferClass self => Signal self (Int -> String -> Int -> IO ()) +entryBufferInsertedText = Signal (connect_INT_STRING_INT__NONE "inserted_text") + +-- | +-- +-- * Available since Gtk+ version 2.18 +-- +entryBufferDeletedText :: EntryBufferClass self => Signal self (Int -> Int -> IO ()) +entryBufferDeletedText = Signal (connect_INT_INT__NONE "deleted_text") + +#endif diff --git a/Graphics/UI/Gtk/Entry/EntryCompletion.chs b/Graphics/UI/Gtk/Entry/EntryCompletion.chs --- a/Graphics/UI/Gtk/Entry/EntryCompletion.chs +++ b/Graphics/UI/Gtk/Entry/EntryCompletion.chs @@ -141,7 +141,7 @@ import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes -import System.Glib.GObject (constructNewGObject, +import System.Glib.GObject (wrapNewGObject, makeNewGObject, destroyFunPtr) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} @@ -163,7 +163,7 @@ -- entryCompletionNew :: IO EntryCompletion entryCompletionNew = - constructNewGObject mkEntryCompletion $ + wrapNewGObject mkEntryCompletion $ {# call gtk_entry_completion_new #} -------------------- @@ -560,7 +560,7 @@ -- * Available since Gtk+ version 2.6 -- insertPrefix :: EntryCompletionClass self => Signal self (String -> IO Bool) -insertPrefix = Signal (connect_STRING__BOOL "insert_prefix") +insertPrefix = Signal (connect_STRING__BOOL "insert-prefix") #endif -- %hash c:d50e d:ad7e @@ -569,13 +569,13 @@ -- text column in the row pointed to by @iter@. -- matchSelected :: EntryCompletionClass self => Signal self (TreeModel -> TreeIter -> IO Bool) -matchSelected = Signal (connect_OBJECT_BOXED__BOOL "match_selected" peekTreeIter) +matchSelected = Signal (connect_OBJECT_BOXED__BOOL "match-selected" peekTreeIter) -- %hash c:21ac d:2cbc -- | Gets emitted when an action is activated. -- completionActionActivated :: EntryCompletionClass self => Signal self (Int -> IO ()) -completionActionActivated = Signal (connect_INT__NONE "action_activated") +completionActionActivated = Signal (connect_INT__NONE "action-activated") #ifndef DISABLE_DEPRECATED #if GTK_CHECK_VERSION(2,6,0) diff --git a/Graphics/UI/Gtk/Entry/HScale.chs b/Graphics/UI/Gtk/Entry/HScale.chs --- a/Graphics/UI/Gtk/Entry/HScale.chs +++ b/Graphics/UI/Gtk/Entry/HScale.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget HScale -- diff --git a/Graphics/UI/Gtk/Entry/SpinButton.chs b/Graphics/UI/Gtk/Entry/SpinButton.chs --- a/Graphics/UI/Gtk/Entry/SpinButton.chs +++ b/Graphics/UI/Gtk/Entry/SpinButton.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget SpinButton -- diff --git a/Graphics/UI/Gtk/Entry/VScale.chs b/Graphics/UI/Gtk/Entry/VScale.chs --- a/Graphics/UI/Gtk/Entry/VScale.chs +++ b/Graphics/UI/Gtk/Entry/VScale.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget VScale -- diff --git a/Graphics/UI/Gtk/Gdk/AppLaunchContext.chs b/Graphics/UI/Gtk/Gdk/AppLaunchContext.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Gdk/AppLaunchContext.chs @@ -0,0 +1,143 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget AppLaunchContext +-- +-- Author : Andy Stewart +-- +-- Created: 30 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- +module Graphics.UI.Gtk.Gdk.AppLaunchContext ( +#if GTK_CHECK_VERSION(2,14,0) +-- * Types + AppLaunchContext, + AppLaunchContextClass, + castToAppLaunchContext, + gTypeAppLaunchContext, + toAppLaunchContext, + +-- * Constructors + appLaunchContextNew, + +-- * Methods + appLaunchContextSetDisplay, + appLaunchContextSetScreen, + appLaunchContextSetDesktop, + appLaunchContextSetTimestamp, + appLaunchContextSetIconName, +#ifdef HAVE_GIO + appLaunchContextSetIcon, +#endif +#endif + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.UTFString +import System.Glib.GObject (wrapNewGObject) +import Graphics.UI.Gtk.Gdk.EventM (TimeStamp) +{#import Graphics.UI.Gtk.Types#} +#ifdef HAVE_GIO +{#import System.GIO.Types#} (Icon (..), IconClass, toIcon) +#endif + +{# context lib="gdk" prefix="gdk" #} + +#if GTK_CHECK_VERSION(2,14,0) +-------------------- +-- Constructors + +-- | Creates a new 'AppLaunchContext'. +appLaunchContextNew :: IO AppLaunchContext +appLaunchContextNew = + wrapNewGObject mkAppLaunchContext $ + {# call gdk_app_launch_context_new #} + +-------------------- +-- Methods + +-- | Sets the workspace on which applications will be launched when using this context when running under +-- a window manager that supports multiple workspaces, as described in the Extended Window Manager +-- Hints. +-- +-- When the workspace is not specified or desktop is set to -1, it is up to the window manager to pick +-- one, typically it will be the current workspace. +appLaunchContextSetDesktop :: AppLaunchContext -> Int -> IO () +appLaunchContextSetDesktop self desktop = + {# call gdk_app_launch_context_set_desktop #} + self + (fromIntegral desktop) + +-- | Sets the display on which applications will be launched when using this context. See also +-- 'appLaunchContextSetScreen'. +appLaunchContextSetDisplay :: AppLaunchContext -> Display -> IO () +appLaunchContextSetDisplay self display = + {# call gdk_app_launch_context_set_display #} + self + display + +#ifdef HAVE_GIO +-- | Sets the icon for applications that are launched with this context. +-- +-- Window Managers can use this information when displaying startup notification. +appLaunchContextSetIcon :: IconClass icon => AppLaunchContext -> icon -> IO () +appLaunchContextSetIcon self icon = + {# call gdk_app_launch_context_set_icon #} + self + (toIcon icon) +#endif + +-- | Sets the icon for applications that are launched with this context. The @iconName@ will be +-- interpreted in the same way as the Icon field in desktop files. See also +-- 'appLaunchContextSetIcon'. +-- +-- If both icon and @iconName@ are set, the @iconName@ takes priority. If neither icon or @iconName@ is +-- set, the icon is taken from either the file that is passed to launched application or from the +-- GAppInfo for the launched application itself. +appLaunchContextSetIconName :: AppLaunchContext -> String -> IO () +appLaunchContextSetIconName self iconName = + withUTFString iconName $ \iconNamePtr -> + {# call gdk_app_launch_context_set_icon_name #} + self + iconNamePtr + +-- | Sets the screen on which applications will be launched when using this context. See also +-- 'appLaunchContextSetDisplay'. +-- +-- If both screen and display are set, the screen takes priority. If neither screen or display are set, +-- the default screen and display are used. +appLaunchContextSetScreen :: AppLaunchContext -> Screen -> IO () +appLaunchContextSetScreen self screen = + {# call gdk_app_launch_context_set_screen #} + self + screen + +-- | Sets the timestamp of context. The timestamp should ideally be taken from the event that triggered +-- the launch. +-- +-- Window managers can use this information to avoid moving the focus to the newly launched application +-- when the user is busy typing in another window. This is also known as 'focus stealing prevention'. +appLaunchContextSetTimestamp :: AppLaunchContext -> TimeStamp -> IO () +appLaunchContextSetTimestamp self timestamp = + {# call gdk_app_launch_context_set_timestamp #} + self + (fromIntegral timestamp) +#endif diff --git a/Graphics/UI/Gtk/Gdk/Cursor.chs b/Graphics/UI/Gtk/Gdk/Cursor.chs --- a/Graphics/UI/Gtk/Gdk/Cursor.chs +++ b/Graphics/UI/Gtk/Gdk/Cursor.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Cursor -- @@ -151,7 +152,7 @@ Cursor -- ^ @cursor@ 'Cursor' -> IO Display -- ^ return the 'Display' associated to cursor cursorGetDisplay cursor = - constructNewGObject mkDisplay $ {#call cursor_get_display#} cursor + makeNewGObject mkDisplay $ {#call cursor_get_display#} cursor -- | Returns a 'Pixbuf' with the image used to display the cursor. -- Note that depending on the capabilities of the windowing system and on the cursor, GDK may not be able to obtain the image data. @@ -160,4 +161,4 @@ Cursor -- ^ @cursor@ 'Cursor' -> IO (Maybe Pixbuf) -- ^ a 'Pixbuf' representing cursor, or @Nothing@ cursorGetImage cursor = - maybeNull (constructNewGObject mkPixbuf) $ {#call cursor_get_image#} cursor + maybeNull (makeNewGObject mkPixbuf) $ {#call cursor_get_image#} cursor diff --git a/Graphics/UI/Gtk/Gdk/Display.chs b/Graphics/UI/Gtk/Gdk/Display.chs --- a/Graphics/UI/Gtk/Gdk/Display.chs +++ b/Graphics/UI/Gtk/Gdk/Display.chs @@ -138,7 +138,7 @@ -- ^ returns a 'Display', or @Nothing@ if the display -- could not be opened. displayOpen displayName = - maybeNull (makeNewGObject mkDisplay) $ + maybeNull (wrapNewGObject mkDisplay) $ withUTFString displayName $ \displayNamePtr -> {# call gdk_display_open #} displayNamePtr diff --git a/Graphics/UI/Gtk/Gdk/DisplayManager.chs b/Graphics/UI/Gtk/Gdk/DisplayManager.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Gdk/DisplayManager.chs @@ -0,0 +1,115 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget DisplayManager +-- +-- Author : Andy Stewart +-- +-- Created: 29 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- Maintains a list of all open GdkDisplays +-- +-- * Module available since Gdk version 2.2 +-- +module Graphics.UI.Gtk.Gdk.DisplayManager ( + +-- * Detail +-- +-- | The purpose of the 'DisplayManager' singleton object is to offer +-- notification when displays appear or disappear or the default display +-- changes. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----DisplayManager +-- @ + +#if GTK_CHECK_VERSION(2,2,0) +-- * Types + DisplayManager, + DisplayManagerClass, + castToDisplayManager, + toDisplayManager, + +-- * Methods + displayManagerGet, + displayManagerListDisplays, + +-- * Attributes + displayManagerDefaultDisplay, + +-- * Signals + displayManagerOpened, +#endif + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.Attributes +import System.Glib.Properties +import System.Glib.GList +import System.Glib.GObject (constructNewGObject, makeNewGObject) +{#import Graphics.UI.Gtk.Types#} +{#import Graphics.UI.Gtk.Signals#} + +{# context lib="gdk" prefix="gdk" #} + +#if GTK_CHECK_VERSION(2,2,0) +-------------------- +-- Methods + +-- | Returns the global 'DisplayManager' singleton; 'parsePargs', 'init', or +-- 'initCheck' must have been called first. +-- +displayManagerGet :: IO DisplayManager -- ^ returns the singleton 'DisplayManager' object. +displayManagerGet = + constructNewGObject mkDisplayManager $ + {# call gdk_display_manager_get #} + +-- | List all currently open displays. +-- +displayManagerListDisplays :: DisplayManagerClass self => self + -> IO [Display] -- ^ returns a newly allocated list of 'Display' objects. +displayManagerListDisplays self = + {# call gdk_display_manager_list_displays #} + (toDisplayManager self) + >>= fromGSList + >>= mapM (makeNewGObject mkDisplay . return) + +-------------------- +-- Attributes + +-- | The default display. +-- +displayManagerDefaultDisplay :: DisplayManagerClass self => Attr self Display +displayManagerDefaultDisplay = newAttrFromObjectProperty "default-display" + {# call pure unsafe gdk_display_get_type #} + +-------------------- +-- Signals + +-- | The 'displayManagerOpened' signal is emitted when a display is opened. +-- +displayManagerOpened :: DisplayManagerClass self => Signal self (Display -> IO ()) +displayManagerOpened = Signal (connect_OBJECT__NONE "display_opened") +#endif diff --git a/Graphics/UI/Gtk/Gdk/DrawWindow.chs b/Graphics/UI/Gtk/Gdk/DrawWindow.chs --- a/Graphics/UI/Gtk/Gdk/DrawWindow.chs +++ b/Graphics/UI/Gtk/Gdk/DrawWindow.chs @@ -86,7 +86,7 @@ import System.Glib.FFI import System.Glib.Flags (toFlags) -import System.Glib.GObject (makeNewGObject) +import System.Glib.GObject (wrapNewGObject,makeNewGObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Gdk.Enums#} {#import Graphics.UI.Gtk.Gdk.Region#} @@ -555,7 +555,7 @@ -- passed-in handle is a reference to a native window, that is, an Xlib XID -- for X windows and a HWND for Win32. drawWindowForeignNew :: NativeWindowId -> IO (Maybe DrawWindow) -drawWindowForeignNew anid = maybeNull (makeNewGObject mkDrawWindow) $ +drawWindowForeignNew anid = maybeNull (wrapNewGObject mkDrawWindow) $ liftM castPtr $ {#call gdk_window_foreign_new#} (fromNativeWindowId anid) -- | Obtains the root window (parent all other windows are inside) for the default display and screen. diff --git a/Graphics/UI/Gtk/Gdk/EventM.hsc b/Graphics/UI/Gtk/Gdk/EventM.hsc --- a/Graphics/UI/Gtk/Gdk/EventM.hsc +++ b/Graphics/UI/Gtk/Gdk/EventM.hsc @@ -175,7 +175,7 @@ import System.Glib.FFI import System.Glib.Flags import System.Glib.GObject ( makeNewGObject ) -import Graphics.UI.Gtk.Gdk.Keys (KeyVal, keyName) +import Graphics.UI.Gtk.Gdk.Keys (KeyVal, KeyCode, keyName) import Graphics.UI.Gtk.Gdk.Region (Region, makeNewRegion) import Graphics.UI.Gtk.Gdk.Enums (Modifier(..), VisibilityState(..), CrossingMode(..), NotifyType(..), WindowState(..), ScrollDirection(..), @@ -466,7 +466,7 @@ eventKeyName = liftM keyName $ eventKeyVal -- | The hardware key code. -eventHardwareKeycode :: EventM EKey Word16 +eventHardwareKeycode :: EventM EKey KeyCode eventHardwareKeycode = ask >>= \ptr -> liftIO $ liftM fromIntegral (#{peek GdkEventKey, hardware_keycode} ptr :: IO #{gtk2hs_type guint16}) diff --git a/Graphics/UI/Gtk/Gdk/Events.hsc b/Graphics/UI/Gtk/Gdk/Events.hsc --- a/Graphics/UI/Gtk/Gdk/Events.hsc +++ b/Graphics/UI/Gtk/Gdk/Events.hsc @@ -105,7 +105,7 @@ -- -- * EventProperty is not bound since it involves Atoms and its hard to see -- how a Haskell application should extract the data. It should be possible --- to connect directly to property-changed signals. If there is a need +-- to connect directly to 'propertyChanged' signals. If there is a need -- to monitor a property for which there is no signal we could add -- a trigger for just that property. -- diff --git a/Graphics/UI/Gtk/Gdk/GC.chs b/Graphics/UI/Gtk/Gdk/GC.chs --- a/Graphics/UI/Gtk/Gdk/GC.chs +++ b/Graphics/UI/Gtk/Gdk/GC.chs @@ -85,7 +85,7 @@ #endif import System.Glib.FFI -import System.Glib.GObject (constructNewGObject) +import System.Glib.GObject (wrapNewGObject) {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.Structs import Graphics.UI.Gtk.General.Enums (Function(..), Fill(..), SubwindowMode(..), LineStyle(..), @@ -100,7 +100,7 @@ gcNew d = do gcPtr <- {#call unsafe gc_new#} (toDrawable d) if (gcPtr==nullPtr) then return (error "gcNew: null graphics context.") - else constructNewGObject mkGC (return gcPtr) + else wrapNewGObject mkGC (return gcPtr) -- | Creates a graphics context with specific values. @@ -108,7 +108,7 @@ gcNewWithValues :: DrawableClass d => d -> GCValues -> IO GC gcNewWithValues d gcv = allocaBytes (sizeOf gcv) $ \vPtr -> do mask <- pokeGCValues vPtr gcv - gc <- constructNewGObject mkGC $ {#call unsafe gc_new_with_values#} + gc <- wrapNewGObject mkGC $ {#call unsafe gc_new_with_values#} (toDrawable d) (castPtr vPtr) mask handle (const $ return ()) $ when (isJust (tile gcv)) $ touchForeignPtr ((unPixmap.fromJust.tile) gcv) diff --git a/Graphics/UI/Gtk/Gdk/Gdk.chs b/Graphics/UI/Gtk/Gdk/Gdk.chs --- a/Graphics/UI/Gtk/Gdk/Gdk.chs +++ b/Graphics/UI/Gtk/Gdk/Gdk.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Gdk -- diff --git a/Graphics/UI/Gtk/Gdk/Keymap.chs b/Graphics/UI/Gtk/Gdk/Keymap.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Gdk/Keymap.chs @@ -0,0 +1,367 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget Keymap +-- +-- Author : Andy Stewart +-- +-- Created: 30 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- Functions for manipulating keyboard codes +-- +module Graphics.UI.Gtk.Gdk.Keymap ( + +-- * Details +-- +-- | Key values are the codes which are sent whenever a key is pressed or released. They appear in the +-- keyval field of the 'EventKey' structure, which is passed to signal handlers for the +-- 'keyPressEvent' and 'keyReleaseEvent' signals. +-- +-- Key values are regularly updated from the upstream X.org X11 implementation, so new values are added +-- regularly. They will be prefixed with GDK_ rather than XF86XK_ or ' (for older symbols)'. +-- +-- Key values can be converted into a string representation using 'keyvalName'. The reverse +-- function, converting a string to a key value, is provided by 'keyvalFromName'. +-- +-- The case of key values can be determined using 'keyvalIsUpper'. Key +-- values can be converted to upper or lower case using 'keyvalToUpper' and +-- 'keyvalToLower'. +-- +-- When it makes sense, key values can be converted to and from Unicode characters with +-- 'keyvalToUnicode'. +-- +-- One 'Keymap' object exists for each user display. 'keymapGetDefault' returns the 'Keymap' +-- for the default display; to obtain keymaps for other displays, use 'keymapGetForDisplay'. A +-- keymap is a mapping from 'KeymapKey' to key values. You can think of a 'KeymapKey' as a +-- representation of a symbol printed on a physical keyboard key. That is, it contains three pieces of +-- information. First, it contains the hardware keycode; this is an identifying number for a physical +-- key. Second, it contains the level of the key. The level indicates which symbol on the key will be +-- used, in a vertical direction. So on a standard US keyboard, the key with the number \"1\" on it also +-- has the exclamation point \"!\" character on it. The level indicates whether to use the \"1\" or the +-- \"!\" symbol. The letter keys are considered to have a lowercase letter at level 0, and an uppercase +-- letter at level 1, though only the uppercase letter is printed. Third, the 'KeymapKey' contains a +-- group; groups are not used on standard US keyboards, but are used in many other countries. On a +-- keyboard with groups, there can be 3 or 4 symbols printed on a single key. The group indicates +-- movement in a horizontal direction. Usually groups are used for two different languages. In group 0, +-- a key might have two English characters, and in group 1 it might have two Hebrew characters. The +-- Hebrew characters will be printed on the key next to the English characters. +-- +-- In order to use a keymap to interpret a key event, it's necessary to first convert the keyboard +-- state into an effective group and level. This is done via a set of rules that varies widely +-- according to type of keyboard and user configuration. The function +-- 'keymapTranslateKeyboardState' accepts a keyboard state -- consisting of hardware keycode +-- pressed, active modifiers, and active group -- applies the appropriate rules, and returns the +-- group/level to be used to index the keymap, along with the modifiers which did not affect the group +-- and level. i.e. it returns "unconsumed modifiers." The keyboard group may differ from the effective +-- group used for keymap lookups because some keys don't have multiple groups - e.g. the Enter key is +-- always in group 0 regardless of keyboard state. +-- +-- Note that 'keymapTranslateKeyboardState' also returns the keyval, i.e. it goes ahead and +-- performs the keymap lookup in addition to telling you which effective group/level values were used +-- for the lookup. 'EventKey' already contains this keyval, however, so you don't normally need to +-- call 'keymapTranslateKeyboardState' just to get the keyval. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----Keymap +-- @ + +-- * Types + Keymap, + KeymapClass, + castToKeymap, + toKeymap, + KeymapKey, + +-- * Methods + keymapGetDefault, +#if GTK_CHECK_VERSION(2,2,0) + keymapGetForDisplay, +#endif + keymapLookupKey, + keymapTranslateKeyboardState, + keymapGetEntriesForKeyval, + keymapGetEntriesForKeycode, + keymapGetDirection, +#if GTK_CHECK_VERSION(2,12,0) + keymapHaveBidiLayouts, +#endif +#if GTK_CHECK_VERSION(2,16,0) + keymapGetCapsLockState, +#endif + +-- * Signals +#if GTK_CHECK_VERSION(2,0,0) + keymapDirectionChanged, +#if GTK_CHECK_VERSION(2,2,0) + keymapKeysChanged, +#if GTK_CHECK_VERSION(2,16,0) + keymapStateChanged, +#endif +#endif +#endif + ) where + +import Control.Monad (liftM) +import Data.Maybe (fromMaybe) +import System.Glib.FFI +import System.Glib.UTFString +import Graphics.UI.Gtk.Gdk.Enums (Modifier(..)) +import Graphics.UI.Gtk.Gdk.Keys (KeyVal (..)) +{#import Graphics.Rendering.Pango.Enums#} +{#import Graphics.UI.Gtk.Types#} +{#import Graphics.UI.Gtk.Signals#} +import Graphics.UI.Gtk.General.Structs (KeymapKey (..)) + +{# context lib="gdk" prefix="gdk" #} + +-------------------- +-- Methods + +-- | Returns the 'Keymap' attached to the default display. +-- +keymapGetDefault :: + IO Keymap -- ^ returns the 'Keymap' attached to the default display. +keymapGetDefault = + makeNewGObject mkKeymap $ + {# call gdk_keymap_get_default #} + +#if GTK_CHECK_VERSION(2,2,0) +-- | Returns the 'Keymap' attached to @display@. +-- +-- * Available since Gdk version 2.2 +-- +keymapGetForDisplay :: + Display -- ^ @display@ - the 'Display'. + -> IO Keymap -- ^ returns the 'Keymap' attached to @display@. +keymapGetForDisplay display = + makeNewGObject mkKeymap $ + {# call gdk_keymap_get_for_display #} + display +#endif + +-- | Looks up the keyval mapped to a keycode\/group\/level triplet. If no +-- keyval is bound to @key@, returns 0. For normal user input, you want to use +-- 'keymapTranslateKeyboardState' instead of this function, since the effective +-- group\/level may not be the same as the current keyboard state. +-- +keymapLookupKey :: KeymapClass self + => (Maybe self) -- ^ @keymap@ a 'Keymap' or 'Nothing' to use the default keymap + -> KeymapKey -- ^ @key@ - a 'KeymapKey' + -- with keycode, group, and level initialized + -> IO Int -- ^ returns a keyval, or 0 if none was mapped to + -- the given @key@ +keymapLookupKey Nothing key = + liftM fromIntegral $ + allocaBytes {# sizeof GdkKeymapKey #} $ \ keyPtr -> do + poke keyPtr key + {# call gdk_keymap_lookup_key #} + (Keymap nullForeignPtr) + (castPtr keyPtr) +keymapLookupKey (Just self) key = + liftM fromIntegral $ + allocaBytes {# sizeof GdkKeymapKey #} $ \ keyPtr -> do + poke keyPtr key + {# call gdk_keymap_lookup_key #} + (toKeymap self) + (castPtr keyPtr) + +-- | Translates the contents of a 'EventKey' into a +-- keyval, effective group, and level. Modifiers that affected the translation +-- and are thus unavailable for application use are returned in +-- @consumedModifiers@. See 'keyvalGetKeys' for an explanation of groups and +-- levels. The @effectiveGroup@ is the group that was actually used for the +-- translation; some keys such as Enter are not affected by the active keyboard +-- group. The @level@ is derived from @state@. For convenience, 'EventKey' +-- already contains the translated keyval, so this function +-- isn't as useful as you might think. +-- +keymapTranslateKeyboardState :: KeymapClass self => self + -> Int -- ^ @hardwareKeycode@ - a keycode + -> Modifier -- ^ @state@ - a modifier state + -> Int -- ^ @group@ - active keyboard group + -> IO (Maybe (Int, Int, Int, Modifier)) +keymapTranslateKeyboardState self hardwareKeycode state group = + alloca $ \keyvalPtr -> + alloca $ \effectiveGroupPtr -> + alloca $ \levelPtr -> + alloca $ \modifierPtr -> do + success <- liftM toBool $ + {# call gdk_keymap_translate_keyboard_state #} + (toKeymap self) + (fromIntegral hardwareKeycode) + ((fromIntegral . fromEnum) state) + (fromIntegral group) + keyvalPtr + effectiveGroupPtr + levelPtr + modifierPtr + if success + then do + keyval <- peek keyvalPtr + effectiveGroup <- peek effectiveGroupPtr + level <- peek levelPtr + modifier <- peek modifierPtr + return (Just (fromIntegral keyval + ,fromIntegral effectiveGroup + ,fromIntegral level + ,toEnum $ fromIntegral modifier)) + else return Nothing + +-- | Obtains a list of keycode\/group\/level combinations that will generate +-- @keyval@. Groups and levels are two kinds of keyboard mode; in general, the +-- level determines whether the top or bottom symbol on a key is used, and the +-- group determines whether the left or right symbol is used. On US keyboards, +-- the shift key changes the keyboard level, and there are no groups. A group +-- switch key might convert a keyboard between Hebrew to English modes, for +-- example. 'EventKey' contains a @group@ field that +-- indicates the active keyboard group. The level is computed from the modifier +-- mask. +-- +keymapGetEntriesForKeyval :: KeymapClass self => self + -> KeyVal -- ^ @keyval@ - a keyval, such as @GDK_a@, @GDK_Up@, + -- @GDK_Return@, etc. + -> IO (Maybe [KeymapKey]) +keymapGetEntriesForKeyval self keyval = + alloca $ \nKeysPtr -> + allocaArray 0 $ \ keysPtr -> do + success <- liftM toBool $ + {# call gdk_keymap_get_entries_for_keyval #} + (toKeymap self) + (fromIntegral keyval) + (castPtr keysPtr) + nKeysPtr + if success + then do + nKeys <- liftM fromIntegral $ peek nKeysPtr + keys <- peekArray nKeys keysPtr + keyList <- mapM peek keys + {#call unsafe g_free#} (castPtr keysPtr) + return (Just keyList) + else return Nothing + +-- | Returns the keyvals bound to @hardwareKeycode@. The Nth 'KeymapKey' +-- in @keys@ is bound to the Nth keyval in @keyvals@. +-- When a keycode is pressed by the user, the +-- keyval from this list of entries is selected by considering the effective +-- keyboard group and level. See 'keymapTranslateKeyboardState'. +-- +keymapGetEntriesForKeycode :: KeymapClass self => self + -> Int -- ^ @hardwareKeycode@ - a keycode + -> IO (Maybe ([KeymapKey], [KeyVal])) +keymapGetEntriesForKeycode self hardwareKeycode = + alloca $ \nEntriesPtr -> + allocaArray 0 $ \ keysPtr -> + allocaArray 0 $ \ keyvalsPtr -> do + success <- liftM toBool $ + {# call gdk_keymap_get_entries_for_keycode #} + (toKeymap self) + (fromIntegral hardwareKeycode) + (castPtr keysPtr) + keyvalsPtr + nEntriesPtr + if success + then do + nEntries <- liftM fromIntegral $ peek nEntriesPtr + keys <- peekArray nEntries keysPtr + keyvals <- peekArray nEntries keyvalsPtr + keyvalsList <- mapM (\x -> liftM fromIntegral $ peek x) keyvals + keysList <- mapM peek keys + {#call unsafe g_free#} (castPtr keysPtr) + {#call unsafe g_free#} (castPtr keyvalsPtr) + return (Just (keysList, keyvalsList)) + else return Nothing + +-- | Returns the direction of effective layout of the keymap. +-- +-- Returns the direction of the keymap. +-- +keymapGetDirection :: KeymapClass self => self + -> IO PangoDirection -- ^ returns 'DirectionLtr' or 'DirectionRtl' if it can + -- determine the direction. 'DirectionNeutral' otherwise. +keymapGetDirection self = + liftM (toEnum . fromIntegral) $ + {# call gdk_keymap_get_direction #} + (toKeymap self) + +#if GTK_CHECK_VERSION(2,12,0) +-- | Determines if keyboard layouts for both right-to-left and left-to-right +-- languages are in use. +-- +-- * Available since Gdk version 2.12 +-- +keymapHaveBidiLayouts :: KeymapClass self => self + -> IO Bool -- ^ returns @True@ if there are layouts in both directions, + -- @False@ otherwise +keymapHaveBidiLayouts self = + liftM toBool $ + {# call gdk_keymap_have_bidi_layouts #} + (toKeymap self) +#endif + +#if GTK_CHECK_VERSION(2,16,0) +-- | Returns whether the Caps Lock modifer is locked. +-- +-- * Available since Gdk version 2.16 +-- +keymapGetCapsLockState :: KeymapClass self => self + -> IO Bool -- ^ returns @True@ if Caps Lock is on +keymapGetCapsLockState self = + liftM toBool $ + {# call gdk_keymap_get_caps_lock_state #} + (toKeymap self) +#endif + +-------------------- +-- Signals + +#if GTK_CHECK_VERSION(2,0,0) +-- | The 'keymapDirectionChanged' signal gets emitted when the direction of the +-- keymap changes. +-- +-- * Available since Gdk version 2.0 +-- +keymapDirectionChanged :: KeymapClass self => Signal self (IO ()) +keymapDirectionChanged = Signal (connect_NONE__NONE "direction_changed") + +#if GTK_CHECK_VERSION(2,2,0) +-- | The 'keymapKeysChanged' signal is emitted when the mapping represented by +-- @keymap@ changes. +-- +-- * Available since Gdk version 2.2 +-- +keymapKeysChanged :: KeymapClass self => Signal self (IO ()) +keymapKeysChanged = Signal (connect_NONE__NONE "keys_changed") + +#if GTK_CHECK_VERSION(2,16,0) +-- | The 'keymapStateChanged' signal is emitted when the state of the keyboard +-- changes, e.g when Caps Lock is turned on or off. See +-- 'keymapGetCapsLockState'. +-- +-- * Available since Gdk version 2.16 +-- +keymapStateChanged :: KeymapClass self => Signal self (IO ()) +keymapStateChanged = Signal (connect_NONE__NONE "state_changed") +#endif +#endif +#endif + diff --git a/Graphics/UI/Gtk/Gdk/Keys.chs b/Graphics/UI/Gtk/Gdk/Keys.chs --- a/Graphics/UI/Gtk/Gdk/Keys.chs +++ b/Graphics/UI/Gtk/Gdk/Keys.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Keys -- @@ -29,6 +30,7 @@ -- module Graphics.UI.Gtk.Gdk.Keys ( KeyVal, + KeyCode, keyName, keyFromName, keyToChar, @@ -36,6 +38,11 @@ keyvalName, keyvalFromName, keyvalToChar, + keyvalConvertCase, + keyvalToUpper, + keyvalToLower, + keyvalIsUpper, + keyvalIsLower, ) where import Control.Monad (liftM) @@ -49,6 +56,7 @@ -- released. -- type KeyVal = Word32 +type KeyCode = Word16 -- | Converts a key value into a symbolic name. -- @@ -85,3 +93,60 @@ {# call gdk_keyval_to_unicode #} (fromIntegral keyval) >>= \code -> if code == 0 then return Nothing else return $ Just $ toEnum $ fromIntegral code + +-- | Obtains the upper- and lower-case versions of the keyval symbol. Examples of keyvals are GDK_a, +-- 'Enter', 'F1', etc. +keyvalConvertCase :: KeyVal -- ^ @symbol@ a keyval + -> (KeyVal, KeyVal) -- ^ @(lower, upper)@ + -- ^ lower is the lowercase version of symbol. + -- ^ upper is uppercase version of symbol. +keyvalConvertCase keyval = + unsafePerformIO $ + alloca $ \ lowerPtr -> + alloca $ \ upperPtr -> do + {#call gdk_keyval_convert_case #} + (fromIntegral keyval) + lowerPtr + upperPtr + lower <- peek lowerPtr + upper <- peek upperPtr + return (fromIntegral lower, fromIntegral upper) + +-- | Converts a key value to upper case, if applicable. +keyvalToUpper :: KeyVal -- ^ @keyval@ a key value. + -> KeyVal -- ^ returns the upper case form of keyval, + -- or keyval itself if it is already in upper case or it is not subject to case +keyvalToUpper keyval = + unsafePerformIO $ + liftM fromIntegral $ + {#call gdk_keyval_to_upper #} + (fromIntegral keyval) + +-- | Converts a key value to lower case, if applicable. +keyvalToLower :: KeyVal -- ^ @keyval@ a key value. + -> KeyVal -- ^ returns the lower case form of keyval, + -- or keyval itself if it is already in lower case or it is not subject to case +keyvalToLower keyval = + unsafePerformIO $ + liftM fromIntegral $ + {#call gdk_keyval_to_lower #} + (fromIntegral keyval) + +-- | Returns 'True' if the given key value is in upper case. +keyvalIsLower :: KeyVal + -> Bool -- ^ returns 'True' if keyval is in upper case, or if keyval is not subject to case conversion. +keyvalIsLower keyval = + unsafePerformIO $ + liftM toBool $ + {#call gdk_keyval_is_lower #} + (fromIntegral keyval) + +-- | Returns 'True' if the given key value is in upper case. +keyvalIsUpper :: KeyVal + -> Bool -- ^ returns 'True' if keyval is in upper case, or if keyval is not subject to case conversion. +keyvalIsUpper keyval = + unsafePerformIO $ + liftM toBool $ + {#call gdk_keyval_is_upper #} + (fromIntegral keyval) + diff --git a/Graphics/UI/Gtk/Gdk/Pixbuf.chs b/Graphics/UI/Gtk/Gdk/Pixbuf.chs --- a/Graphics/UI/Gtk/Gdk/Pixbuf.chs +++ b/Graphics/UI/Gtk/Gdk/Pixbuf.chs @@ -266,7 +266,7 @@ -- pixbufNewFromFile :: FilePath -> IO Pixbuf pixbufNewFromFile fname = - constructNewGObject mkPixbuf $ + wrapNewGObject mkPixbuf $ propagateGError $ \errPtrPtr -> withUTFString fname $ \strPtr -> #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) @@ -289,7 +289,7 @@ -- pixbufNewFromFileAtSize :: String -> Int -> Int -> IO Pixbuf pixbufNewFromFileAtSize filename width height = - constructNewGObject mkPixbuf $ + wrapNewGObject mkPixbuf $ propagateGError $ \errPtrPtr -> withUTFString filename $ \filenamePtr -> #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) @@ -327,7 +327,7 @@ -> Bool -- ^ whether to preserve the aspect ratio -> IO Pixbuf pixbufNewFromFileAtScale filename width height preserveAspectRatio = - constructNewGObject mkPixbuf $ + wrapNewGObject mkPixbuf $ propagateGError $ \errPtrPtr -> withUTFString filename $ \filenamePtr -> #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) @@ -397,7 +397,7 @@ -- pixbufNew :: Colorspace -> Bool -> Int -> Int -> Int -> IO Pixbuf pixbufNew colorspace hasAlpha bitsPerSample width height = - constructNewGObject mkPixbuf $ + wrapNewGObject mkPixbuf $ {#call pixbuf_new#} ((fromIntegral . fromEnum) colorspace) (fromBool hasAlpha) (fromIntegral bitsPerSample) (fromIntegral width) (fromIntegral height) @@ -409,7 +409,7 @@ pixbufNewFromXPMData :: [String] -> IO Pixbuf pixbufNewFromXPMData s = withUTFStringArray0 s $ \strsPtr -> - constructNewGObject mkPixbuf $ {#call pixbuf_new_from_xpm_data#} strsPtr + wrapNewGObject mkPixbuf $ {#call pixbuf_new_from_xpm_data#} strsPtr -- | A dymmy type for inline picture data. -- @@ -458,7 +458,7 @@ pixbufNewFromInline iPtr = alloca $ \errPtrPtr -> do pbPtr <- {#call unsafe pixbuf_new_from_inline#} (-1) (castPtr iPtr) (fromBool False) (castPtr errPtrPtr) - if pbPtr/=nullPtr then constructNewGObject mkPixbuf (return pbPtr) + if pbPtr/=nullPtr then wrapNewGObject mkPixbuf (return pbPtr) else do errPtr <- peek errPtrPtr (GError dom code msg) <- peek errPtr @@ -474,7 +474,7 @@ -- pixbufNewSubpixbuf :: Pixbuf -> Int -> Int -> Int -> Int -> IO Pixbuf pixbufNewSubpixbuf pb srcX srcY height width = - constructNewGObject mkPixbuf $ do + wrapNewGObject mkPixbuf $ do pbPtr <- {#call unsafe pixbuf_new_subpixbuf#} pb (fromIntegral srcX) (fromIntegral srcY) (fromIntegral height) (fromIntegral width) @@ -484,7 +484,7 @@ -- | Create a deep copy of an image. -- pixbufCopy :: Pixbuf -> IO Pixbuf -pixbufCopy pb = constructNewGObject mkPixbuf $ {#call unsafe pixbuf_copy#} pb +pixbufCopy pb = wrapNewGObject mkPixbuf $ {#call unsafe pixbuf_copy#} pb -- | How an image is scaled. @@ -531,7 +531,7 @@ -> InterpType -- ^ interpolation type -> IO Pixbuf pixbufScaleSimple pb width height interp = - constructNewGObject mkPixbuf $ liftM castPtr $ + wrapNewGObject mkPixbuf $ liftM castPtr $ {#call pixbuf_scale_simple#} (toPixbuf pb) (fromIntegral width) (fromIntegral height) (fromIntegral $ fromEnum interp) @@ -609,7 +609,7 @@ -- pixbufFlipHorizontally :: Pixbuf -> IO Pixbuf pixbufFlipHorizontally self = - constructNewGObject mkPixbuf $ + wrapNewGObject mkPixbuf $ {# call pixbuf_flip #} self (fromBool True) @@ -619,7 +619,7 @@ -- pixbufFlipVertically :: Pixbuf -> IO Pixbuf pixbufFlipVertically self = - constructNewGObject mkPixbuf $ + wrapNewGObject mkPixbuf $ {# call pixbuf_flip #} self (fromBool False) @@ -629,7 +629,7 @@ -- pixbufRotateSimple :: Pixbuf -> PixbufRotation -> IO Pixbuf pixbufRotateSimple self angle = - constructNewGObject mkPixbuf $ + wrapNewGObject mkPixbuf $ {# call pixbuf_rotate_simple #} self ((fromIntegral . fromEnum) angle) @@ -655,9 +655,9 @@ -- during this substitution. -- pixbufAddAlpha :: Pixbuf -> Maybe (Word8, Word8, Word8) -> IO Pixbuf -pixbufAddAlpha pb Nothing = constructNewGObject mkPixbuf $ +pixbufAddAlpha pb Nothing = wrapNewGObject mkPixbuf $ {#call unsafe pixbuf_add_alpha#} pb (fromBool False) 0 0 0 -pixbufAddAlpha pb (Just (r,g,b)) = constructNewGObject mkPixbuf $ +pixbufAddAlpha pb (Just (r,g,b)) = wrapNewGObject mkPixbuf $ {#call unsafe pixbuf_add_alpha#} pb (fromBool True) (fromIntegral r) (fromIntegral g) (fromIntegral b) @@ -709,7 +709,7 @@ -- pixbufGetFromDrawable :: DrawableClass d => d -> Rectangle -> IO (Maybe Pixbuf) pixbufGetFromDrawable d (Rectangle x y width height) = - maybeNull (constructNewGObject mkPixbuf) $ + maybeNull (wrapNewGObject mkPixbuf) $ {#call unsafe pixbuf_get_from_drawable#} (Pixbuf nullForeignPtr) (toDrawable d) (Colormap nullForeignPtr) (fromIntegral x) (fromIntegral y) 0 0 @@ -774,8 +774,8 @@ (castPtr pmRetPtr) -- seems to reject Pixmap**, so cast (castPtr bmRetPtr) (fromIntegral threshold) - pm <- constructNewGObject mkPixmap (peek pmRetPtr :: IO (Ptr Pixmap)) - bm <- maybeNull (constructNewGObject mkPixmap) (peek bmRetPtr :: IO (Ptr Bitmap)) + pm <- wrapNewGObject mkPixmap (peek pmRetPtr :: IO (Ptr Pixmap)) + bm <- maybeNull (wrapNewGObject mkPixmap) (peek bmRetPtr :: IO (Ptr Bitmap)) return (pm, bm) diff --git a/Graphics/UI/Gtk/Gdk/PixbufAnimation.chs b/Graphics/UI/Gtk/Gdk/PixbufAnimation.chs --- a/Graphics/UI/Gtk/Gdk/PixbufAnimation.chs +++ b/Graphics/UI/Gtk/Gdk/PixbufAnimation.chs @@ -106,7 +106,7 @@ pixbufAnimationNewFromFile :: FilePath -- ^ Name of file to load, in the GLib file name encoding -> IO PixbufAnimation -- ^ A newly-created animation pixbufAnimationNewFromFile fname = - constructNewGObject mkPixbufAnimation $ + wrapNewGObject mkPixbufAnimation $ propagateGError $ \errPtrPtr -> withUTFString fname $ \strPtr -> #if defined (WIN32) && GTK_CHECK_VERSION(2,6,5) @@ -162,7 +162,7 @@ -> Maybe GTimeVal -- ^ time when the animation starts playing -> IO PixbufAnimationIter -- ^ an iterator to move over the animation pixbufAnimationGetIter self tv = maybeWith with tv $ \stPtr -> - constructNewGObject mkPixbufAnimationIter $ + wrapNewGObject mkPixbufAnimationIter $ {#call unsafe pixbuf_animation_get_iter#} self (castPtr stPtr) @@ -187,7 +187,7 @@ pixbufAnimationGetStaticImage :: PixbufAnimation -> IO (Maybe Pixbuf) -- ^ unanimated image representing the animation pixbufAnimationGetStaticImage self = - maybeNull (constructNewGObject mkPixbuf) $ {#call unsafe pixbuf_animation_get_static_image#} self + maybeNull (makeNewGObject mkPixbuf) $ {#call unsafe pixbuf_animation_get_static_image#} self @@ -254,7 +254,7 @@ -- pixbufAnimationIterGetPixbuf :: PixbufAnimationIter -- ^ an animation iterator -> IO Pixbuf -- ^ the pixbuf to be displayed -pixbufAnimationIterGetPixbuf iter = constructNewGObject mkPixbuf $ +pixbufAnimationIterGetPixbuf iter = makeNewGObject mkPixbuf $ {# call unsafe pixbuf_animation_iter_get_pixbuf #} iter @@ -267,7 +267,7 @@ -> Int -- ^ the height of the animation -> Float -- ^ the speed of the animation, in frames per second -> IO PixbufSimpleAnim -- ^ a newly allocated 'PixbufSimpleAnim' -pixbufSimpleAnimNew width height rate = constructNewGObject mkPixbufSimpleAnim $ +pixbufSimpleAnimNew width height rate = wrapNewGObject mkPixbufSimpleAnim $ {#call unsafe pixbuf_simple_anim_new#} (fromIntegral width) (fromIntegral height) (realToFrac rate) diff --git a/Graphics/UI/Gtk/Gdk/Pixmap.chs b/Graphics/UI/Gtk/Gdk/Pixmap.chs --- a/Graphics/UI/Gtk/Gdk/Pixmap.chs +++ b/Graphics/UI/Gtk/Gdk/Pixmap.chs @@ -53,7 +53,7 @@ import Data.Maybe import System.Glib.FFI -import System.Glib.GObject (constructNewGObject) +import System.Glib.GObject (wrapNewGObject) {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.Gdk.Drawable (Drawable, DrawableClass(..)) @@ -83,7 +83,7 @@ -> Maybe Int -- ^ @depth@ - depth of the pixmap -> IO Pixmap pixmapNew mbDrawable width height depth = - constructNewGObject mkPixmap $ + wrapNewGObject mkPixmap $ {# call unsafe pixmap_new #} (maybe (Drawable nullForeignPtr) toDrawable mbDrawable) (fromIntegral width) (fromIntegral height) @@ -97,7 +97,7 @@ -> Maybe Int -- ^ @depth@ - depth of the pixmap -> IO Pixmap pixmapNew mbDrawWindow width height depth = - constructNewGObject mkPixmap $ + wrapNewGObject mkPixmap $ {# call unsafe pixmap_new #} (maybe (DrawWindow nullForeignPtr) toDrawWindow mbDrawWindow) (fromIntegral width) (fromIntegral height) diff --git a/Graphics/UI/Gtk/Gdk/Screen.chs b/Graphics/UI/Gtk/Gdk/Screen.chs --- a/Graphics/UI/Gtk/Gdk/Screen.chs +++ b/Graphics/UI/Gtk/Gdk/Screen.chs @@ -479,7 +479,7 @@ -> IO (Maybe DrawWindow) -- ^ returns the currently active window, or -- @Nothing@. screenGetActiveWindow self = - maybeNull (makeNewGObject mkDrawWindow) $ + maybeNull (wrapNewGObject mkDrawWindow) $ {# call gdk_screen_get_active_window #} self #endif @@ -503,7 +503,7 @@ screenGetWindowStack self = do lPtr <- {# call gdk_screen_get_window_stack #} self if lPtr==nullPtr then return Nothing else liftM Just $ do - fromGList lPtr >>= mapM (constructNewGObject mkDrawWindow . return) + fromGList lPtr >>= mapM (wrapNewGObject mkDrawWindow . return) #endif -------------------- @@ -539,7 +539,7 @@ -- screen changes. -- screenSizeChanged :: ScreenClass self => Signal self (IO ()) -screenSizeChanged = Signal (connect_NONE__NONE "size_changed") +screenSizeChanged = Signal (connect_NONE__NONE "size-changed") #if GTK_CHECK_VERSION(2,10,0) -- | The 'screenCompositedChanged' signal is emitted when the composited status of @@ -548,7 +548,7 @@ -- * Available since Gdk version 2.10 -- screenCompositedChanged :: ScreenClass self => Signal self (IO ()) -screenCompositedChanged = Signal (connect_NONE__NONE "composited_changed") +screenCompositedChanged = Signal (connect_NONE__NONE "composited-changed") #if GTK_CHECK_VERSION(2,14,0) -- | The 'screenMonitorsChanged' signal is emitted when the number, size or diff --git a/Graphics/UI/Gtk/General/Drag.chs b/Graphics/UI/Gtk/General/Drag.chs --- a/Graphics/UI/Gtk/General/Drag.chs +++ b/Graphics/UI/Gtk/General/Drag.chs @@ -619,7 +619,7 @@ -- drag icon with 'dragSourceSetIcon'. -- dragBegin :: WidgetClass self => Signal self (DragContext -> IO ()) -dragBegin = Signal (connect_OBJECT__NONE "drag_begin") +dragBegin = Signal (connect_OBJECT__NONE "drag-begin") -- %hash c:bfef d:a2ff -- | The 'dragDataDelete' signal is emitted on the drag source when a drag @@ -628,10 +628,10 @@ -- means, depends on the context of the drag operation. -- dragDataDelete :: WidgetClass self => Signal self (DragContext -> IO ()) -dragDataDelete = Signal (connect_OBJECT__NONE "drag_data_delete") +dragDataDelete = Signal (connect_OBJECT__NONE "drag-data-delete") -- %hash c:eb9c d:844c --- | The ::drag-data-get signal is emitted on the drag source when the +-- | The 'dragDataGet' signal is emitted on the drag source when the -- drop site requests the data which is dragged. It is the -- responsibility of the signal handler to set the selection data in -- the format which is indicated by 'InfoId'. See @@ -641,7 +641,7 @@ dragDataGet :: WidgetClass self => Signal self (DragContext -> InfoId -> TimeStamp -> SelectionDataM ()) dragDataGet = Signal (\after object handler -> do - connect_OBJECT_PTR_WORD_WORD__NONE "drag_data_get" after object $ + connect_OBJECT_PTR_WORD_WORD__NONE "drag-data-get" after object $ \ctxt dataPtr info time -> do runReaderT (handler ctxt (fromIntegral info) (fromIntegral time)) dataPtr >> return ()) @@ -663,7 +663,7 @@ dragDataReceived :: WidgetClass self => Signal self (DragContext -> Point -> InfoId -> TimeStamp -> SelectionDataM ()) dragDataReceived = Signal (\after object handler -> do - connect_OBJECT_INT_INT_PTR_WORD_WORD__NONE "drag_data_received" after object $ + connect_OBJECT_INT_INT_PTR_WORD_WORD__NONE "drag-data-received" after object $ \ctxt x y dataPtr info time -> do runReaderT (handler ctxt (fromIntegral x, fromIntegral y) (fromIntegral info) (fromIntegral time)) dataPtr >> return ()) @@ -682,7 +682,7 @@ dragDrop :: WidgetClass self => Signal self (DragContext -> Point -> TimeStamp -> IO Bool) dragDrop = Signal (\after object handler -> - connect_OBJECT_INT_INT_WORD__BOOL "drag_drop" after object $ \ctxt x y time -> + connect_OBJECT_INT_INT_WORD__BOOL "drag-drop" after object $ \ctxt x y time -> handler ctxt (fromIntegral x, fromIntegral y) (fromIntegral time)) -- %hash c:9d4e d:a5ac @@ -691,7 +691,7 @@ -- in 'dragBegin'. -- dragEnd :: WidgetClass self => Signal self (DragContext -> IO ()) -dragEnd = Signal (connect_OBJECT__NONE "drag_end") +dragEnd = Signal (connect_OBJECT__NONE "drag-end") #if GTK_CHECK_VERSION(2,12,0) -- | The 'dragFailed' signal is emitted on the drag source when a drag has @@ -703,7 +703,7 @@ -- * Available since Gtk+ 2.12.0. -- dragFailed :: WidgetClass self => Signal self (DragContext -> DragResult -> IO Bool) -dragFailed = Signal (connect_OBJECT_ENUM__BOOL "drag_failed") +dragFailed = Signal (connect_OBJECT_ENUM__BOOL "drag-failed") #endif -- %hash c:4a85 d:6122 @@ -713,7 +713,7 @@ -- dragLeave :: WidgetClass self => Signal self (DragContext -> TimeStamp -> IO ()) dragLeave = Signal (\after object handler -> - connect_OBJECT_WORD__NONE "drag_leave" after object $ \ctxt time -> + connect_OBJECT_WORD__NONE "drag-leave" after object $ \ctxt time -> handler ctxt (fromIntegral time)) -- %hash c:53f7 d:176d @@ -737,6 +737,6 @@ dragMotion :: WidgetClass self => Signal self (DragContext -> Point -> TimeStamp -> IO Bool) dragMotion = Signal (\after object handler -> do - connect_OBJECT_INT_INT_WORD__BOOL "drag_motion" after object $ \ctxt x y time -> + connect_OBJECT_INT_INT_WORD__BOOL "drag-motion" after object $ \ctxt x y time -> handler ctxt (fromIntegral x, fromIntegral y) (fromIntegral time)) diff --git a/Graphics/UI/Gtk/General/Enums.chs b/Graphics/UI/Gtk/General/Enums.chs --- a/Graphics/UI/Gtk/General/Enums.chs +++ b/Graphics/UI/Gtk/General/Enums.chs @@ -45,7 +45,9 @@ MatchType(..), #endif MenuDirectionType(..), +#if GTK_CHECK_VERSION(2,8,0) MetricType(..), +#endif MovementStep(..), Orientation(..), Packing(..), toPacking, fromPacking, @@ -81,7 +83,10 @@ WindowPosition(..), WindowType(..), WrapMode(..), - module Graphics.UI.Gtk.Gdk.Enums + EntryIconPosition(..), + AnchorType (..), + +module Graphics.UI.Gtk.Gdk.Enums ) where import System.Glib.Flags (Flags) @@ -330,7 +335,7 @@ -- {#enum ShadowType {underscoreToCase} deriving (Eq,Show)#} --- Sort a 'Graphics.UI.Gtk.TreeList.TreeViewColumn' in ascending or descending +-- Sort a 'Graphics.UI.Gtk.ModelView.TreeViewColumn' in ascending or descending -- order. -- {#enum SortType {underscoreToCase} deriving (Eq,Show)#} @@ -419,4 +424,11 @@ -- {#enum WrapMode {underscoreToCase} deriving (Eq,Show)#} +-- | Specifies the side of the entry at which an icon is placed. +-- +{#enum EntryIconPosition {underscoreToCase} deriving (Eq,Show)#} + +-- | +-- +{#enum AnchorType {underscoreToCase} deriving (Eq,Show)#} diff --git a/Graphics/UI/Gtk/General/General.chs b/Graphics/UI/Gtk/General/General.chs --- a/Graphics/UI/Gtk/General/General.chs +++ b/Graphics/UI/Gtk/General/General.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) General -- @@ -17,10 +18,6 @@ -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details. -- --- TODO --- --- quitAddDestroy, quitAdd, quitRemove --- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional @@ -50,6 +47,11 @@ mainIteration, mainIterationDo, mainDoEvent, + + -- ** Call when mainloop is left + quitAddDestroy, + quitAdd, + quitRemove, -- * Grab widgets grabAdd, @@ -257,7 +259,7 @@ -- While you should not call this function directly, you might want to know how exactly events are -- handled. So here is what this function does with the event: -- --- 1. Compress enter/leave notify events. If the event passed build an enter/leave pair together with +-- 1. Compress enter\/leave notify events. If the event passed build an enter\/leave pair together with -- the next event (peeked from GDK) both events are thrown away. This is to avoid a backlog of -- (de-)highlighting widgets crossed by the pointer. -- @@ -289,6 +291,40 @@ mainDoEvent = do ptr <- ask liftIO $ {#call main_do_event #} (castPtr ptr) + +-- | Trigger destruction of object in case the mainloop at level @mainLevel@ is quit. +quitAddDestroy :: ObjectClass obj + => Int -- ^ @mainLevel@ Level of the mainloop which shall trigger the destruction. + -> obj -- ^ @object@ Object to be destroyed. + -> IO () +quitAddDestroy mainLevel obj = + {#call quit_add_destroy #} + (fromIntegral mainLevel) + (toObject obj) + +-- | Registers a function to be called when an instance of the mainloop is left. +quitAdd :: Int -- ^ @mainLevel@ Level at which termination the function shall be called. You can pass 0 here to have the function run at the current mainloop. + -> (IO Bool) -- ^ @function@ The function to call. This should return 'False' to be removed from the list of quit handlers. Otherwise the function might be called again. + -> IO Int -- ^ returns A handle for this quit handler (you need this for 'quitRemove') +quitAdd mainLevel func = do + funcPtr <- mkGtkFunction $ \ _ -> + liftM fromBool func + liftM fromIntegral $ + {#call quit_add #} + (fromIntegral mainLevel) + funcPtr + nullPtr + +{#pointer GtkFunction#} + +foreign import ccall "wrapper" mkGtkFunction :: + (Ptr () -> IO {#type gboolean#}) -> IO GtkFunction + +-- | Removes a quit handler by its identifier. +quitRemove :: Int -- ^ @quitHandlerId@ Identifier for the handler returned when installing it. + -> IO () +quitRemove quitHandlerId = + {#call quit_remove #} (fromIntegral quitHandlerId) -- | add a grab widget -- diff --git a/Graphics/UI/Gtk/General/IconFactory.chs b/Graphics/UI/Gtk/General/IconFactory.chs --- a/Graphics/UI/Gtk/General/IconFactory.chs +++ b/Graphics/UI/Gtk/General/IconFactory.chs @@ -18,14 +18,6 @@ -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details. -- --- 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. --- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional @@ -115,7 +107,7 @@ import System.Glib.FFI import System.Glib.UTFString -import System.Glib.GObject (constructNewGObject, makeNewGObject) +import System.Glib.GObject (wrapNewGObject, makeNewGObject) {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.Enums (TextDirection(..), StateType(..)) import Graphics.UI.Gtk.General.StockItems @@ -149,7 +141,7 @@ -- iconFactoryNew :: IO IconFactory iconFactoryNew = - constructNewGObject mkIconFactory {#call unsafe icon_factory_new#} + wrapNewGObject mkIconFactory {#call unsafe icon_factory_new#} -------------------- -- Methods @@ -222,7 +214,7 @@ -> IconSize -> widget -> IO Pixbuf -iconSetRenderIcon set dir state size widget = makeNewGObject mkPixbuf $ +iconSetRenderIcon set dir state size widget = wrapNewGObject mkPixbuf $ {#call icon_set_render_icon#} set (Style nullForeignPtr) ((fromIntegral.fromEnum) dir) ((fromIntegral.fromEnum) state) ((fromIntegral.fromEnum) size) (toWidget widget) nullPtr diff --git a/Graphics/UI/Gtk/General/IconTheme.chs b/Graphics/UI/Gtk/General/IconTheme.chs --- a/Graphics/UI/Gtk/General/IconTheme.chs +++ b/Graphics/UI/Gtk/General/IconTheme.chs @@ -107,7 +107,7 @@ iconThemeChooseIcon, #ifdef HAVE_GIO #if GTK_CHECK_VERSION(2,14,0) - iconThemeLookupByGicon, + iconThemeLookupByGIcon, #endif #endif #endif @@ -147,7 +147,7 @@ import System.Glib.UTFString import System.Glib.GList import System.Glib.Flags -import System.Glib.GObject (constructNewGObject, makeNewGObject, Quark) +import System.Glib.GObject (wrapNewGObject, makeNewGObject, Quark) import System.Glib.GError (GErrorDomain, GErrorClass(..), propagateGError) import Graphics.UI.Gtk.General.Structs (Rectangle, Point) {#import Graphics.UI.Gtk.Types#} @@ -175,7 +175,7 @@ -- iconThemeNew :: IO IconTheme iconThemeNew = - constructNewGObject mkIconTheme $ + wrapNewGObject mkIconTheme $ {# call gtk_icon_theme_new #} -------------------- @@ -372,7 +372,7 @@ -- -- * Available since Gtk+ version 2.14 -- -iconThemeLookupByGicon :: (IconThemeClass self, IconClass icon) => self +iconThemeLookupByGIcon :: (IconThemeClass self, IconClass icon) => self -> icon -- ^ @icon@ - the 'Icon' to look up -> Int -- ^ @size@ - desired icon size -> IconLookupFlags -- ^ @flags@ - flags modifying the behavior of the @@ -380,7 +380,7 @@ -> IO (Maybe IconInfo) -- ^ returns a 'IconInfo' -- structure containing information about the icon, or -- 'Nothing' if the icon wasn't found. -iconThemeLookupByGicon self icon size flags = do +iconThemeLookupByGIcon self icon size flags = do iiPtr <- {# call gtk_icon_theme_lookup_by_gicon #} (toIconTheme self) (toIcon icon) @@ -416,7 +416,7 @@ -- so you must not modify the icon. -- `Nothing` if the icon isn't found. iconThemeLoadIcon self iconName size flags = - maybeNull (makeNewGObject mkPixbuf) $ + maybeNull (wrapNewGObject mkPixbuf) $ propagateGError $ \errorPtr -> withUTFString iconName $ \iconNamePtr -> {# call gtk_icon_theme_load_icon #} @@ -664,7 +664,7 @@ -- loaded, which would be a waste of memory. iconInfoLoadIcon :: IconInfo -> IO Pixbuf iconInfoLoadIcon self = - makeNewGObject mkPixbuf $ + wrapNewGObject mkPixbuf $ propagateGError $ \errorPtr -> {# call gtk_icon_info_load_icon #} self diff --git a/Graphics/UI/Gtk/General/RcStyle.chs b/Graphics/UI/Gtk/General/RcStyle.chs --- a/Graphics/UI/Gtk/General/RcStyle.chs +++ b/Graphics/UI/Gtk/General/RcStyle.chs @@ -476,7 +476,7 @@ -- rcStyleNew :: IO RcStyle rcStyleNew = - constructNewGObject mkRcStyle $ + wrapNewGObject mkRcStyle $ {# call gtk_rc_style_new #} -------------------- @@ -488,7 +488,7 @@ rcStyleCopy :: RcStyleClass self => self -> IO RcStyle -- ^ returns the resulting 'RcStyle' rcStyleCopy self = - constructNewGObject mkRcStyle $ + wrapNewGObject mkRcStyle $ {# call gtk_rc_style_copy #} (toRcStyle self) diff --git a/Graphics/UI/Gtk/General/Selection.chs b/Graphics/UI/Gtk/General/Selection.chs --- a/Graphics/UI/Gtk/General/Selection.chs +++ b/Graphics/UI/Gtk/General/Selection.chs @@ -340,7 +340,7 @@ selectionDataGetPixbuf :: SelectionDataM (Maybe Pixbuf) selectionDataGetPixbuf = do selPtr <- ask - liftIO $ maybeNull (constructNewGObject mkPixbuf) $ + liftIO $ maybeNull (wrapNewGObject mkPixbuf) $ {#call unsafe gtk_selection_data_get_pixbuf #} selPtr -- %hash c:d222 d:af3f @@ -471,7 +471,7 @@ -- selectionReceived :: WidgetClass self => Signal self (TimeStamp -> SelectionDataM ()) selectionReceived = Signal (\after object handler -> do - connect_PTR_WORD__NONE "selection_received" after object $ \dataPtr time -> do + connect_PTR_WORD__NONE "selection-received" after object $ \dataPtr time -> do runReaderT (handler (fromIntegral time)) dataPtr >> return ()) -- %hash c:c3 d:af3f @@ -482,7 +482,7 @@ selectionGet :: WidgetClass self => Signal self (InfoId -> TimeStamp -> SelectionDataM ()) selectionGet = Signal (\after object handler -> do - connect_PTR_WORD_WORD__NONE "selection_get" after object $ + connect_PTR_WORD_WORD__NONE "selection-get" after object $ \dataPtr info time -> do runReaderT (handler (fromIntegral info) (fromIntegral time)) dataPtr >> return ()) 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 @@ -100,7 +100,8 @@ selectionTypeInteger, selectionTypeString, selectionDataGetType, - withTargetEntries + withTargetEntries, + KeymapKey (..) ) where import Control.Monad (liftM) @@ -1001,3 +1002,35 @@ #{poke GtkTargetEntry, target} ptr cPtr #{poke GtkTargetEntry, flags} ptr (0::#{gtk2hs_type guint}) #{poke GtkTargetEntry, info} ptr info + +-- | A 'KeymapKey' is a hardware key that can be mapped to a keyval. +data KeymapKey = KeymapKey { + keycode :: Int -- ^ @keycode@ the hardware keycode. This is an identifying number for a physical key. + ,group :: Int -- ^ @group@ indicates movement in a horizontal direction. + -- Usually groups are used for two different languages. + -- In group 0, a key might have two English characters, + -- and in group 1 it might have two Hebrew characters. + -- The Hebrew characters will be printed on the key next to the English characters. + -- indicates which symbol on the key will be used, + -- in a vertical direction. So on a standard US keyboard, the + ,level :: Int -- ^ @level@ key with the number "1" on it also has the exclamation + -- point ("!") character on it. The level + -- indicates whether to use the "1" or the "!" symbol. The letter keys are considered to + -- have a lowercase letter at level 0, and an uppercase letter at level 1, though only + -- the uppercase letter is printed. + } deriving (Eq, Show) + +instance Storable KeymapKey where + sizeOf _ = #{const sizeof(GdkKeymapKey)} + alignment _ = alignment (undefined::#gtk2hs_type gint) + peek ptr = do + (keycode_ ::#gtk2hs_type guint) <- #{peek GdkKeymapKey, keycode} ptr + (group_ ::#gtk2hs_type gint) <- #{peek GdkKeymapKey, group} ptr + (level_ ::#gtk2hs_type gint) <- #{peek GdkKeymapKey, level} ptr + return $ KeymapKey (fromIntegral keycode_) (fromIntegral group_) (fromIntegral level_) + poke ptr (KeymapKey keycode group level) = do + #{poke GdkKeymapKey, keycode} ptr ((fromIntegral keycode)::#gtk2hs_type guint) + #{poke GdkKeymapKey, group} ptr ((fromIntegral group)::#gtk2hs_type gint) + #{poke GdkKeymapKey, level} ptr ((fromIntegral level)::#gtk2hs_type gint) + + diff --git a/Graphics/UI/Gtk/General/Style.chs b/Graphics/UI/Gtk/General/Style.chs --- a/Graphics/UI/Gtk/General/Style.chs +++ b/Graphics/UI/Gtk/General/Style.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Styles -- diff --git a/Graphics/UI/Gtk/Layout/AspectFrame.chs b/Graphics/UI/Gtk/Layout/AspectFrame.chs --- a/Graphics/UI/Gtk/Layout/AspectFrame.chs +++ b/Graphics/UI/Gtk/Layout/AspectFrame.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget AspectFrame -- diff --git a/Graphics/UI/Gtk/Layout/Expander.chs b/Graphics/UI/Gtk/Layout/Expander.chs --- a/Graphics/UI/Gtk/Layout/Expander.chs +++ b/Graphics/UI/Gtk/Layout/Expander.chs @@ -82,6 +82,9 @@ expanderUseMarkup, expanderSpacing, expanderLabelWidget, +#if GTK_CHECK_VERSION(2,22,0) + expanderLabelFill, +#endif -- * Signals onActivate, @@ -94,6 +97,7 @@ import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes +import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.Signals @@ -313,6 +317,15 @@ expanderLabelWidget = newAttr expanderGetLabelWidget expanderSetLabelWidget + +#if GTK_CHECK_VERSION(2,22,0) +-- | Whether the label widget should fill all available horizontal space. +-- +-- Default value: 'False' +-- +expanderLabelFill :: Attr Expander Bool +expanderLabelFill = newAttrFromBoolProperty "label-fill" +#endif -------------------- -- Signals diff --git a/Graphics/UI/Gtk/Layout/Fixed.chs b/Graphics/UI/Gtk/Layout/Fixed.chs --- a/Graphics/UI/Gtk/Layout/Fixed.chs +++ b/Graphics/UI/Gtk/Layout/Fixed.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Fixed -- diff --git a/Graphics/UI/Gtk/Layout/HBox.chs b/Graphics/UI/Gtk/Layout/HBox.chs --- a/Graphics/UI/Gtk/Layout/HBox.chs +++ b/Graphics/UI/Gtk/Layout/HBox.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget HBox -- diff --git a/Graphics/UI/Gtk/Layout/HButtonBox.chs b/Graphics/UI/Gtk/Layout/HButtonBox.chs --- a/Graphics/UI/Gtk/Layout/HButtonBox.chs +++ b/Graphics/UI/Gtk/Layout/HButtonBox.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget HButtonBox -- diff --git a/Graphics/UI/Gtk/Layout/HPaned.chs b/Graphics/UI/Gtk/Layout/HPaned.chs --- a/Graphics/UI/Gtk/Layout/HPaned.chs +++ b/Graphics/UI/Gtk/Layout/HPaned.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget HPaned -- diff --git a/Graphics/UI/Gtk/Layout/Layout.chs b/Graphics/UI/Gtk/Layout/Layout.chs --- a/Graphics/UI/Gtk/Layout/Layout.chs +++ b/Graphics/UI/Gtk/Layout/Layout.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Layout -- diff --git a/Graphics/UI/Gtk/Layout/Notebook.chs b/Graphics/UI/Gtk/Layout/Notebook.chs --- a/Graphics/UI/Gtk/Layout/Notebook.chs +++ b/Graphics/UI/Gtk/Layout/Notebook.chs @@ -127,6 +127,10 @@ notebookSetTabDetachable, notebookGetTabDetachable, #endif +#if GTK_CHECK_VERSION(2,20,0) + notebookSetActionWidget, + notebookGetActionWidget, +#endif -- * Attributes notebookPage, @@ -976,6 +980,40 @@ {# call notebook_get_tab_detachable #} (toNotebook self) (toWidget child) +#endif + +#if GTK_CHECK_VERSION(2,20,0) +-- | Sets widget as one of the action widgets. Depending on the pack type the widget will be placed +-- before or after the tabs. You can use a 'Box' if you need to pack more than one widget on the same +-- side. +-- +-- Note that action widgets are "internal" children of the notebook and thus not included in the list +-- returned from 'containerForeach'. +-- +-- * Available since Gtk version 2.20 +-- +notebookSetActionWidget :: (NotebookClass self, WidgetClass widget) => self + -> widget + -> PackType -- ^ @packType@ pack type of the action widget + -> IO () +notebookSetActionWidget self widget packType = + {#call gtk_notebook_set_action_widget #} + (toNotebook self) + (toWidget widget) + ((fromIntegral . fromEnum) packType) + +-- | Gets one of the action widgets. See 'notebookSetActionWidget'. +-- +-- * Available since Gtk version 2.20 +-- +notebookGetActionWidget :: NotebookClass self => self + -> PackType -- ^ @packType@ pack type of the action widget to receive + -> IO (Maybe Widget) +notebookGetActionWidget self packType = + maybeNull (makeNewObject mkWidget) $ + {#call gtk_notebook_get_action_widget #} + (toNotebook self) + ((fromIntegral . fromEnum) packType) #endif -------------------- diff --git a/Graphics/UI/Gtk/Layout/Table.chs b/Graphics/UI/Gtk/Layout/Table.chs --- a/Graphics/UI/Gtk/Layout/Table.chs +++ b/Graphics/UI/Gtk/Layout/Table.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Table -- @@ -80,6 +81,9 @@ tableGetDefaultColSpacing, tableSetHomogeneous, tableGetHomogeneous, +#if GTK_CHECK_VERSION(2,22,0) + tableGetSize, +#endif -- * Attributes tableNRows, @@ -327,6 +331,26 @@ liftM toBool $ {# call unsafe table_get_homogeneous #} (toTable self) + +#if GTK_CHECK_VERSION(2,22,0) +-- | Returns the size of 'Table'. +-- +-- * Available since Gtk+ version 2.22 +-- +tableGetSize :: TableClass self => self + -> IO (Int, Int) -- ^ returns (rows, columns) of table +tableGetSize self = + alloca $ \ rowsPtr -> + alloca $ \ columnsPtr -> do + {# call unsafe gtk_table_get_size #} + (toTable self) + rowsPtr + columnsPtr + rows <- peek rowsPtr + columns <- peek columnsPtr + return (fromIntegral rows, fromIntegral columns) + +#endif -------------------- -- Attributes diff --git a/Graphics/UI/Gtk/Layout/VBox.chs b/Graphics/UI/Gtk/Layout/VBox.chs --- a/Graphics/UI/Gtk/Layout/VBox.chs +++ b/Graphics/UI/Gtk/Layout/VBox.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget VBox -- diff --git a/Graphics/UI/Gtk/Layout/VButtonBox.chs b/Graphics/UI/Gtk/Layout/VButtonBox.chs --- a/Graphics/UI/Gtk/Layout/VButtonBox.chs +++ b/Graphics/UI/Gtk/Layout/VButtonBox.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget VButtonBox -- diff --git a/Graphics/UI/Gtk/Layout/VPaned.chs b/Graphics/UI/Gtk/Layout/VPaned.chs --- a/Graphics/UI/Gtk/Layout/VPaned.chs +++ b/Graphics/UI/Gtk/Layout/VPaned.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget VPaned -- diff --git a/Graphics/UI/Gtk/MenuComboToolbar/CheckMenuItem.chs b/Graphics/UI/Gtk/MenuComboToolbar/CheckMenuItem.chs --- a/Graphics/UI/Gtk/MenuComboToolbar/CheckMenuItem.chs +++ b/Graphics/UI/Gtk/MenuComboToolbar/CheckMenuItem.chs @@ -63,7 +63,7 @@ -- * Methods checkMenuItemSetActive, checkMenuItemGetActive, - checkMenuItemToggled, + checkMenuItemEmitToggled, checkMenuItemSetInconsistent, checkMenuItemGetInconsistent, #if GTK_CHECK_VERSION(2,4,0) @@ -77,6 +77,9 @@ #if GTK_CHECK_VERSION(2,4,0) checkMenuItemDrawAsRadio, #endif + +-- * Signals + checkMenuItemToggled ) where import Control.Monad (liftM) @@ -85,6 +88,7 @@ import System.Glib.UTFString import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +{#import Graphics.UI.Gtk.Signals#} {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} @@ -149,8 +153,8 @@ -- | Emits the toggled signal. -- -checkMenuItemToggled :: CheckMenuItemClass self => self -> IO () -checkMenuItemToggled self = +checkMenuItemEmitToggled :: CheckMenuItemClass self => self -> IO () +checkMenuItemEmitToggled self = {# call check_menu_item_toggled #} (toCheckMenuItem self) @@ -232,3 +236,7 @@ checkMenuItemSetDrawAsRadio #endif +-- | This signal is emitted when the state of the check box is changed. +-- +checkMenuItemToggled :: CheckMenuItemClass self => Signal self (IO ()) +checkMenuItemToggled = Signal (connect_NONE__NONE "toggled") diff --git a/Graphics/UI/Gtk/MenuComboToolbar/ImageMenuItem.chs b/Graphics/UI/Gtk/MenuComboToolbar/ImageMenuItem.chs --- a/Graphics/UI/Gtk/MenuComboToolbar/ImageMenuItem.chs +++ b/Graphics/UI/Gtk/MenuComboToolbar/ImageMenuItem.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ImageMenuItem -- diff --git a/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs b/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs --- a/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs +++ b/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget MenuItem -- @@ -78,9 +79,9 @@ menuItemSetSubmenu, menuItemGetSubmenu, menuItemRemoveSubmenu, - menuItemSelect, - menuItemDeselect, - menuItemActivate, + menuItemEmitSelect, + menuItemEmitDeselect, + menuItemEmitActivate, menuItemSetRightJustified, menuItemGetRightJustified, menuItemSetAccelPath, @@ -90,6 +91,14 @@ menuItemRightJustified, -- * Signals + menuItemActivateItem, + menuItemActivate, + menuItemSelect, + menuItemDeselect, + menuItemToggle, + +#ifndef DISABLE_DEPRECATED +-- * Deprecated onActivateItem, afterActivateItem, onActivateLeaf, @@ -100,6 +109,7 @@ afterDeselect, onToggle, afterToggle +#endif ) where import Control.Monad (liftM) @@ -182,22 +192,22 @@ -- | Select the menu item. Emits the \"select\" signal on the item. -- -menuItemSelect :: MenuItemClass self => self -> IO () -menuItemSelect self = +menuItemEmitSelect :: MenuItemClass self => self -> IO () +menuItemEmitSelect self = {# call menu_item_select #} (toMenuItem self) -- | Deselect the menu item. Emits the \"deselect\" signal on the item. -- -menuItemDeselect :: MenuItemClass self => self -> IO () -menuItemDeselect self = +menuItemEmitDeselect :: MenuItemClass self => self -> IO () +menuItemEmitDeselect self = {# call menu_item_deselect #} (toMenuItem self) -- | Simulate a click on the menu item. Emits the \"activate\" signal on the item. -- -menuItemActivate :: MenuItemClass self => self -> IO () -menuItemActivate self = +menuItemEmitActivate :: MenuItemClass self => self -> IO () +menuItemEmitActivate self = {# call menu_item_activate #} (toMenuItem self) @@ -276,43 +286,63 @@ -- * This is the only function applications normally connect to. -- It is not emitted if the item has a submenu. -- -onActivateLeaf, afterActivateLeaf :: MenuItemClass self => self - -> IO () - -> IO (ConnectId self) -onActivateLeaf = connect_NONE__NONE "activate" False -afterActivateLeaf = connect_NONE__NONE "activate" True +menuItemActivate :: MenuItemClass self => Signal self (IO ()) +menuItemActivate = Signal (connect_NONE__NONE "activate") -- | Emitted when the user chooses a menu item that has a submenu. -- -- * This signal is not emitted if the menu item does not have a -- submenu. -- +menuItemActivateItem :: MenuItemClass self => Signal self (IO ()) +menuItemActivateItem = Signal (connect_NONE__NONE "activate-item") + +-- | This signal is emitted when the item is selected. +-- +menuItemSelect :: ItemClass i => Signal i (IO ()) +menuItemSelect = Signal (connect_NONE__NONE "select") + +-- | This signal is emitted when the item is deselected. +-- +menuItemDeselect :: ItemClass i => Signal i (IO ()) +menuItemDeselect = Signal (connect_NONE__NONE "deselect") + +-- | This signal is emitted when the item is toggled. +-- +menuItemToggle :: ItemClass i => Signal i (IO ()) +menuItemToggle = Signal (connect_NONE__NONE "toggle") + +#ifndef DISABLE_DEPRECATED +-------------------- +-- Deprecated Signals + +onActivateLeaf, afterActivateLeaf :: MenuItemClass self => self + -> IO () + -> IO (ConnectId self) +onActivateLeaf = connect_NONE__NONE "activate" False +afterActivateLeaf = connect_NONE__NONE "activate" True + onActivateItem, afterActivateItem :: MenuItemClass self => self -> IO () -> IO (ConnectId self) onActivateItem = connect_NONE__NONE "activate-item" False afterActivateItem = connect_NONE__NONE "activate-item" True --- | This signal is emitted when the item is selected. --- onSelect, afterSelect :: ItemClass i => i -> IO () -> IO (ConnectId i) onSelect = connect_NONE__NONE "select" False afterSelect = connect_NONE__NONE "select" True --- | This signal is emitted when the item is deselected. --- onDeselect, afterDeselect :: ItemClass i => i -> IO () -> IO (ConnectId i) onDeselect = connect_NONE__NONE "deselect" False afterDeselect = connect_NONE__NONE "deselect" True --- | This signal is emitted when the item is toggled. --- onToggle, afterToggle :: ItemClass i => i -> IO () -> IO (ConnectId i) -onToggle = connect_NONE__NONE "toggled" False -afterToggle = connect_NONE__NONE "toggled" True +onToggle = connect_NONE__NONE "toggle" False +afterToggle = connect_NONE__NONE "toggle" True +#endif diff --git a/Graphics/UI/Gtk/MenuComboToolbar/RadioMenuItem.chs b/Graphics/UI/Gtk/MenuComboToolbar/RadioMenuItem.chs --- a/Graphics/UI/Gtk/MenuComboToolbar/RadioMenuItem.chs +++ b/Graphics/UI/Gtk/MenuComboToolbar/RadioMenuItem.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget RadioMenuItem -- diff --git a/Graphics/UI/Gtk/MenuComboToolbar/TearoffMenuItem.chs b/Graphics/UI/Gtk/MenuComboToolbar/TearoffMenuItem.chs --- a/Graphics/UI/Gtk/MenuComboToolbar/TearoffMenuItem.chs +++ b/Graphics/UI/Gtk/MenuComboToolbar/TearoffMenuItem.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget TearoffMenuItem -- diff --git a/Graphics/UI/Gtk/MenuComboToolbar/ToolItem.chs b/Graphics/UI/Gtk/MenuComboToolbar/ToolItem.chs --- a/Graphics/UI/Gtk/MenuComboToolbar/ToolItem.chs +++ b/Graphics/UI/Gtk/MenuComboToolbar/ToolItem.chs @@ -86,6 +86,13 @@ toolItemGetProxyMenuItem, toolItemSetProxyMenuItem, +#if GTK_CHECK_VERSION(2,20,0) + toolItemGetEllipsizeMode, + toolItemGetTextAlignment, + toolItemGetTextOrientation, + toolItemGetTextSizeGroup, +#endif + -- * Attributes toolItemVisibleHorizontal, toolItemVisibleVertical, @@ -102,6 +109,8 @@ import System.Glib.UTFString import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +import Graphics.Rendering.Pango.Enums (EllipsizeMode (..)) +import Graphics.UI.Gtk.Misc.SizeGroup {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.Structs (IconSize) import Graphics.UI.Gtk.General.Enums (Orientation(..), ToolbarStyle(..), ReliefStyle(..)) @@ -340,6 +349,47 @@ (toToolItem self) menuItemIdPtr (toWidget menuItem) + +#if GTK_CHECK_VERSION(2,20,0) +-- | Returns the ellipsize mode used for @toolItem@. Custom subclasses of 'ToolItem' should call this +-- function to find out how text should be ellipsized. +-- +-- * Available since Gtk+ version 2.20 +-- +toolItemGetEllipsizeMode :: ToolItemClass item => item + -> IO EllipsizeMode -- ^ returns a PangoEllipsizeMode indicating how text in @toolItem@ should be ellipsized. +toolItemGetEllipsizeMode item = + liftM (toEnum . fromIntegral) $ + {#call gtk_tool_item_get_ellipsize_mode #} + (toToolItem item) + +-- | Returns the text alignment used for @toolItem@. Custom subclasses of 'ToolItem' should call this +-- function to find out how text should be aligned. +toolItemGetTextAlignment :: ToolItemClass item => item + -> IO Double -- ^ returns a gfloat indicating the horizontal text alignment used for @toolItem@ +toolItemGetTextAlignment item = + liftM realToFrac $ + {#call gtk_tool_item_get_text_alignment #} + (toToolItem item) + +-- | Returns the text orientation used for @toolItem@. Custom subclasses of 'ToolItem' should call this +-- function to find out how text should be orientated. +toolItemGetTextOrientation :: ToolItemClass item => item + -> IO Orientation -- ^ returns a 'Orientation' indicating the orientation used for @toolItem@ +toolItemGetTextOrientation item = + liftM (toEnum . fromIntegral) $ + {#call gtk_tool_item_get_text_orientation #} + (toToolItem item) + +-- | Returns the size group used for labels in @toolItem@. Custom subclasses of 'ToolItem' should call +-- this function and use the size group for labels. +toolItemGetTextSizeGroup :: ToolItemClass item => item + -> IO SizeGroup +toolItemGetTextSizeGroup item = + makeNewGObject mkSizeGroup $ + {#call gtk_tool_item_get_text_size_group #} + (toToolItem item) +#endif -------------------- -- Attributes diff --git a/Graphics/UI/Gtk/MenuComboToolbar/ToolItemGroup.chs b/Graphics/UI/Gtk/MenuComboToolbar/ToolItemGroup.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/MenuComboToolbar/ToolItemGroup.chs @@ -0,0 +1,295 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget ToolItemGroup +-- +-- Author : Andy Stewart +-- +-- Created: 08 Sep 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- A sub container used in a tool palette +-- +-- * Module available since Gtk+ version 2.20 +-- +module Graphics.UI.Gtk.MenuComboToolbar.ToolItemGroup ( + +-- * Detail +-- | A 'ToolItemGroup' is used together with 'ToolPalette' to add 'ToolItems' to a palette like +-- container with different categories and drag and drop support. + +-- * Class Hierarchy +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----'Widget' +-- | +----'Container' +-- | +----'ToolItemGroup' +-- @ + +#if GTK_CHECK_VERSION(2,20,0) +-- * Types + ToolItemGroup, + ToolItemGroupClass, + castToToolItemGroup, + toToolItemGroup, + +-- * Constructors + toolItemGroupNew, + +-- * Methods + toolItemGroupGetDropItem, + toolItemGroupGetItemPosition, + toolItemGroupGetNItems, + toolItemGroupGetNthItem, + toolItemGroupInsert, + toolItemGroupSetItemPosition, + +-- * Attributes + toolItemGroupCollapsed, + toolItemGroupEllipsize, + toolItemGroupHeaderRelief, + toolItemGroupLabel, + toolItemGroupLabelWidget, + +-- * Child Attributes + toolItemGroupChildExpand, + toolItemGroupChildFill, + toolItemGroupChildHomogeneous, + toolItemGroupChildNewRow, + toolItemGroupChildPosition, +#endif +) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.Attributes +import System.Glib.Properties +import System.Glib.GList +import System.Glib.UTFString +import Graphics.Rendering.Pango.Enums (EllipsizeMode (..)) +import Graphics.UI.Gtk.General.Enums (ReliefStyle(..)) +import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +{#import Graphics.UI.Gtk.Types#} +{#import Graphics.UI.Gtk.Signals#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,20,0) +-- | Creates a new tool item group with label label. +-- +-- * Available since Gtk+ version 2.20 +-- +toolItemGroupNew :: String -- ^ @label@ the label of the new group + -> IO ToolItemGroup -- ^ returns a new 'ToolItemGroup'. +toolItemGroupNew label = + makeNewObject mkToolItemGroup $ + liftM (castPtr :: Ptr Widget -> Ptr ToolItemGroup) $ + withUTFString label $ \ labelPtr -> + {#call gtk_tool_item_group_new #} + labelPtr + +-- | Gets the tool item at position (x, y). +-- +-- * Available since Gtk+ version 2.20 +-- +toolItemGroupGetDropItem :: ToolItemGroupClass self => self + -> (Int, Int) + -> IO ToolItem +toolItemGroupGetDropItem group (x, y) = + makeNewObject mkToolItem $ + {#call gtk_tool_item_group_get_drop_item #} + (toToolItemGroup group) + (fromIntegral x) + (fromIntegral y) + +-- | Gets the position of item in group as index. +-- +-- * Available since Gtk+ version 2.20 +-- +toolItemGroupGetItemPosition :: (ToolItemGroupClass group, ToolItemClass item) + => group -- ^ @group@ a 'ToolItemGroup' + -> item -- ^ @item@ a 'ToolItem' + -> IO Int -- ^ returns the index of item in group or -1 if item is no child of group +toolItemGroupGetItemPosition group item = + liftM fromIntegral $ + {#call gtk_tool_item_group_get_item_position #} + (toToolItemGroup group) + (toToolItem item) + +-- | Gets the number of tool items in group. +-- +-- * Available since Gtk+ version 2.20 +-- +toolItemGroupGetNItems :: ToolItemGroupClass group => group + -> IO Int -- ^ returns the number of tool items in group +toolItemGroupGetNItems group = + liftM fromIntegral $ + {#call gtk_tool_item_group_get_n_items #} + (toToolItemGroup group) + +-- | Gets the tool item at index in group. +-- +-- * Available since Gtk+ version 2.20 +-- +toolItemGroupGetNthItem :: ToolItemGroupClass group => group + -> Int -- ^ @index@ the index + -> IO ToolItem -- ^ returns the 'ToolItem' at index +toolItemGroupGetNthItem group index = + makeNewObject mkToolItem $ + {#call gtk_tool_item_group_get_nth_item #} + (toToolItemGroup group) + (fromIntegral index) + +-- | Inserts item at position in the list of children of group. +-- +-- * Available since Gtk+ version 2.20 +-- +toolItemGroupInsert :: (ToolItemGroupClass group, ToolItemClass item) + => group -- ^ @group@ a 'ToolItemGroup' + -> item -- ^ @item@ the 'ToolItem' to insert into group + -> Int -- ^ @position@ the position of item in group, starting with 0. + -- The position -1 means end of list. + -> IO () +toolItemGroupInsert group item position = + {#call gtk_tool_item_group_insert #} + (toToolItemGroup group) + (toToolItem item) + (fromIntegral position) + +-- | Sets the position of item in the list of children of group. +-- +-- * Available since Gtk+ version 2.20 +-- +toolItemGroupSetItemPosition :: (ToolItemGroupClass group, ToolItemClass item) + => group -- ^ @group@ a 'ToolItemGroup' + -> item -- ^ @item@ the 'ToolItem' to move to a new position, should be a child of group. + -> Int -- ^ @position@ the new position of item in group, starting with 0. The position -1 means end of list. + -> IO () +toolItemGroupSetItemPosition group item position = + {#call gtk_tool_item_group_set_item_position #} + (toToolItemGroup group) + (toToolItem item) + (fromIntegral position) + +-- | Wether the group has been collapsed and items are hidden. +-- +-- Default value: 'False' +-- +-- * Available since Gtk+ version 2.20 +-- +toolItemGroupCollapsed :: ToolItemGroupClass group => Attr group Bool +toolItemGroupCollapsed = + newAttrFromBoolProperty "collapsed" + +-- | Ellipsize for item group headers. +-- +-- Default value: EllipsizeNone +-- +-- * Available since Gtk+ version 2.20 +-- +toolItemGroupEllipsize :: ToolItemGroupClass group => Attr group EllipsizeMode +toolItemGroupEllipsize = + newAttrFromEnumProperty "ellipsize" + {# call pure unsafe pango_ellipsize_mode_get_type #} + +-- | Relief of the group header button. +-- +-- Default value: 'ReliefNormal' +-- +-- * Available since Gtk+ version 2.20 +-- +toolItemGroupHeaderRelief :: ToolItemGroupClass group => Attr group ReliefStyle +toolItemGroupHeaderRelief = + newAttrFromEnumProperty "header-relief" + {# call pure unsafe gtk_relief_style_get_type #} + +-- | The human-readable title of this item group. +-- +-- Default value: \"\" +-- +-- * Available since Gtk+ version 2.20 +-- +toolItemGroupLabel :: ToolItemGroupClass group => Attr group String +toolItemGroupLabel = + newAttrFromStringProperty "label" + +-- | A widget to display in place of the usual label. +-- +-- * Available since Gtk+ version 2.20 +-- +toolItemGroupLabelWidget :: ToolItemGroupClass group => Attr group Widget +toolItemGroupLabelWidget = + newAttrFromObjectProperty "label-widget" + {# call pure unsafe gtk_widget_get_type #} + +-- | Whether the item should receive extra space when the group grows. +-- +-- Default value: 'False' +-- +-- * Available since Gtk+ version 2.20 +-- +toolItemGroupChildExpand :: ToolItemGroupClass group => Attr group Bool +toolItemGroupChildExpand = + newAttrFromBoolProperty "expand" + +-- | Whether the item should fill the available space. +-- +-- Default value: 'True' +-- +-- * Available since Gtk+ version 2.20 +-- +toolItemGroupChildFill :: ToolItemGroupClass group => Attr group Bool +toolItemGroupChildFill = + newAttrFromBoolProperty "fill" + +-- | Whether the item should be the same size as other homogeneous items. +-- +-- Default value: 'True' +-- +-- * Available since Gtk+ version 2.20 +-- +toolItemGroupChildHomogeneous :: ToolItemGroupClass group => Attr group Bool +toolItemGroupChildHomogeneous = + newAttrFromBoolProperty "homogeneous" + +-- | Whether the item should start a new row. +-- +-- Default value: 'False' +-- +-- * Available since Gtk+ version 2.20 +-- +toolItemGroupChildNewRow :: ToolItemGroupClass group => Attr group Bool +toolItemGroupChildNewRow = + newAttrFromBoolProperty "new-row" + +-- | Position of the item within this group. +-- +-- Allowed values: >= 0 +-- +-- Default value: 0 +-- +-- * Available since Gtk+ version 2.20 +-- +toolItemGroupChildPosition :: ToolItemGroupClass group => Attr group Int +toolItemGroupChildPosition = + newAttrFromIntProperty "position" +#endif + diff --git a/Graphics/UI/Gtk/MenuComboToolbar/ToolPalette.chs b/Graphics/UI/Gtk/MenuComboToolbar/ToolPalette.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/MenuComboToolbar/ToolPalette.chs @@ -0,0 +1,267 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget ToolPalette +-- +-- Author : Andy Stewart +-- +-- Created: 08 Sep 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- A tool palette with categories +-- +-- * Module available since Gtk+ version 2.20 +-- +-- TODO: +-- +-- gtk_tool_palette_add_drag_dest +-- gtk_tool_palette_get_drag_item +-- gtk_tool_palette_get_drag_target_group +-- gtk_tool_palette_get_drag_target_item +-- gtk_tool_palette_get_drop_group +-- gtk_tool_palette_get_drop_item +-- +module Graphics.UI.Gtk.MenuComboToolbar.ToolPalette ( + +-- * Detail +-- | A 'ToolPalette' allows you to add 'ToolItems' to a palette-like container with different +-- categories and drag and drop support. +-- +-- A 'ToolPalette' is created with a call to 'toolPaletteNew'. +-- +-- 'ToolItems' cannot be added directly to a 'ToolPalette' - instead they are added to a +-- 'ToolItemGroup' which can than be added to a 'ToolPalette'. To add a 'ToolItemGroup' to a +-- 'ToolPalette', use 'containerAdd'. +-- +-- The easiest way to use drag and drop with 'ToolPalette' is to call 'toolPaletteAddDragDest' +-- with the desired drag source palette and the desired drag target widget. Then +-- 'toolPaletteGetDragItem' can be used to get the dragged item in the 'dragDataReceived' +-- signal handler of the drag target. + +-- * Class Hierarchy +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----'Widget' +-- | +----'Container' +-- | +----'ToolPalette' +-- @ + +#if GTK_CHECK_VERSION(2,20,0) +-- * Types + ToolPalette, + ToolPaletteClass, + castToToolPalette, + toToolPalette, + +-- * Enums + ToolPaletteDragTargets (..), + +-- * Constructors + toolPaletteNew, + +-- * Methods + toolPaletteUnsetIconSize, + toolPaletteUnsetStyle, + toolPaletteGetHAdjustment, + toolPaletteGetVAdjustment, + +-- * Attributes + toolPaletteSetGroupPosition, + toolPaletteGetGroupPosition, + toolPaletteIconSize, + toolPaletteIconSizeSet, + toolPaletteToolbarStyle, + +-- * Child Attributes + toolPaletteChildExclusive, + toolPaletteChildExpand, + +-- * Signals + toolPaletteSetScrollAdjustments, +#endif +) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.Attributes +import System.Glib.Properties +import System.Glib.GList +import System.Glib.UTFString +import Graphics.UI.Gtk.General.Structs (IconSize (..)) +import Graphics.UI.Gtk.General.Enums (ToolbarStyle (..)) +import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +{#import Graphics.UI.Gtk.Types#} +{#import Graphics.UI.Gtk.Signals#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,20,0) + +-- | Flags used to specify the supported drag targets. +{# enum ToolPaletteDragTargets {underscoreToCase} deriving (Eq) #} + +-- | Creates a new tool palette. +-- +-- * Available since Gtk+ version 2.20 +-- +toolPaletteNew :: IO ToolPalette +toolPaletteNew = + makeNewObject mkToolPalette $ + liftM (castPtr :: Ptr Widget -> Ptr ToolPalette) $ + {#call gtk_tool_palette_new #} + +-- | Unsets the tool palette icon size set with 'toolPaletteSetIconSize', so that user +-- preferences will be used to determine the icon size. +-- +-- * Available since Gtk+ version 2.20 +-- +toolPaletteUnsetIconSize :: ToolPaletteClass self => self -> IO () +toolPaletteUnsetIconSize palette = + {#call gtk_tool_palette_unset_icon_size #} + (toToolPalette palette) + +-- | Unsets a toolbar style set with 'toolPaletteSetStyle', so that user preferences will be used +-- to determine the toolbar style. +-- +-- * Available since Gtk+ version 2.20 +-- +toolPaletteUnsetStyle :: ToolPaletteClass self => self -> IO () +toolPaletteUnsetStyle palette = + {#call gtk_tool_palette_unset_style #} + (toToolPalette palette) + +-- | Gets the horizontal adjustment of the tool palette. +-- +-- * Available since Gtk+ version 2.20 +-- +toolPaletteGetHAdjustment :: ToolPaletteClass self => self + -> IO Adjustment +toolPaletteGetHAdjustment palette = + makeNewObject mkAdjustment $ + {# call gtk_tool_palette_get_hadjustment #} + (toToolPalette palette) + +-- | Gets the vertical adjustment of the tool palette. +-- +-- * Available since Gtk+ version 2.20 +-- +toolPaletteGetVAdjustment :: ToolPaletteClass self => self + -> IO Adjustment +toolPaletteGetVAdjustment palette = + makeNewObject mkAdjustment $ + {# call gtk_tool_palette_get_vadjustment #} + (toToolPalette palette) + +-- | Gets the position of group in palette as index. See 'toolPaletteSetGroupPosition'. +-- +-- * Available since Gtk+ version 2.20 +-- +toolPaletteGetGroupPosition :: (ToolPaletteClass palette, ToolItemGroupClass group) + => palette + -> group + -> IO Int -- ^ returns the index of group or -1 if group is not a child of palette +toolPaletteGetGroupPosition palette group = + liftM fromIntegral $ + {#call gtk_tool_palette_get_group_position #} + (toToolPalette palette) + (toToolItemGroup group) + +-- | Sets the position of the group as an index of the tool palette. If position is 0 the group will +-- become the first child, if position is -1 it will become the last child. +-- +-- * Available since Gtk+ version 2.20 +-- +toolPaletteSetGroupPosition :: (ToolPaletteClass palette, ToolItemGroupClass group) + => palette + -> group + -> Int + -> IO () +toolPaletteSetGroupPosition palette group position = + {#call gtk_tool_palette_set_group_position #} + (toToolPalette palette) + (toToolItemGroup group) + (fromIntegral position) + +-- | The size of the icons in a tool palette is normally determined by the 'toolbarIconSize' +-- setting. When this property is set, it overrides the setting. +-- +-- This should only be used for special-purpose tool palettes, normal application tool palettes should +-- respect the user preferences for the size of icons. +-- +-- Default value: 'IconSizeSmallToolbar' +-- +-- * Available since Gtk+ version 2.20 +-- +toolPaletteIconSize :: ToolPaletteClass self => Attr self IconSize +toolPaletteIconSize = + newAttrFromEnumProperty "icon-size" + {# call pure unsafe gtk_icon_size_get_type #} + +-- | Is 'True' if the 'iconSize' property has been set. +-- +-- Default value: 'False' +-- +-- * Available since Gtk+ version 2.20 +-- +toolPaletteIconSizeSet :: ToolPaletteClass self => Attr self Bool +toolPaletteIconSizeSet = + newAttrFromBoolProperty "icon-size-set" + +-- | The style of items in the tool palette. +-- +-- Default value: 'ToolbarIcons' +-- +-- * Available since Gtk+ version 2.20 +-- +toolPaletteToolbarStyle :: ToolPaletteClass self => Attr self ToolbarStyle +toolPaletteToolbarStyle = + newAttrFromEnumProperty "toolbar-style" + {# call pure unsafe gtk_toolbar_style_get_type #} + +-- | Whether the item group should be the only one that is expanded at a given time. +-- +-- Default value: 'False' +-- +-- * Available since Gtk+ version 2.20 +-- +toolPaletteChildExclusive :: ToolPaletteClass self => Attr self Bool +toolPaletteChildExclusive = + newAttrFromBoolProperty "exclusive" + +-- | Whether the item group should receive extra space when the palette grows. at a given time. +-- +-- Default value: 'False' +-- +-- * Available since Gtk+ version 2.20 +-- +toolPaletteChildExpand :: ToolPaletteClass self => Attr self Bool +toolPaletteChildExpand = + newAttrFromBoolProperty "expand" + +-- | Set the scroll adjustments for the viewport. Usually scrolled containers like 'ScrolledWindow' will +-- emit this signal to connect two instances of 'Scrollbar' to the scroll directions of the +-- 'Toolpalette'. +-- +-- * Available since Gtk+ version 2.20 +-- +toolPaletteSetScrollAdjustments :: ToolPaletteClass self => Signal self (Adjustment -> Adjustment -> IO ()) +toolPaletteSetScrollAdjustments = Signal (connect_OBJECT_OBJECT__NONE "set-scroll-adjustments") +#endif diff --git a/Graphics/UI/Gtk/Misc/Accessible.chs b/Graphics/UI/Gtk/Misc/Accessible.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Misc/Accessible.chs @@ -0,0 +1,93 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget accessible +-- +-- Author : Andy Stewart +-- +-- Created: 23 Oct 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- A 'Object' representing an adjustable bounded value +-- +module Graphics.UI.Gtk.Misc.Accessible ( +-- * Detail +-- +-- | Accessible accessibility support for widgets. +-- + +-- * Class Hierarchy +-- | +-- @ +-- | 'GObject' +-- | +----'AtkObject' +-- | +----Accessible +-- @ + +#if GTK_CHECK_VERSION(2,22,0) +-- * Types + Accessible, + AccessibleClass, + castToAccessible, gTypeAccessible, + toAccessible, + +-- * Methods + accessibleGetWidget, + accessibleSetWidget +#endif +) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.Attributes +import System.Glib.Properties +import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +{#import Graphics.UI.Gtk.Types#} +{#import Graphics.UI.Gtk.Signals#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,22,0) +-------------------- +-- Methods + +-- | Gets the 'Widget' corresponding to the 'Accessible'. +-- +-- * Available since Gtk+ version 2.22 +-- +accessibleGetWidget :: AccessibleClass self => self + -> IO (Maybe Widget) -- ^ returns the 'Widget' corresponding to the 'Accessible', or 'Nothing'. +accessibleGetWidget self = + maybeNull (makeNewObject mkWidget) $ + {# call accessible_get_widget #} + (toAccessible self) + +-- | Sets the 'Widget' corresponding to the 'Accessible'. +-- +-- * Available since Gtk+ version 2.22 +-- +accessibleSetWidget :: (AccessibleClass self, WidgetClass widget) + => self -- ^ @accessible@ a 'Accessible' + -> widget -- ^ @widget@ a 'Widget' + -> IO () +accessibleSetWidget self widget = + {#call accessible_set_widget #} + (toAccessible self) + (toWidget widget) +#endif diff --git a/Graphics/UI/Gtk/Misc/Arrow.chs b/Graphics/UI/Gtk/Misc/Arrow.chs --- a/Graphics/UI/Gtk/Misc/Arrow.chs +++ b/Graphics/UI/Gtk/Misc/Arrow.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Arrow -- diff --git a/Graphics/UI/Gtk/Misc/DrawingArea.chs b/Graphics/UI/Gtk/Misc/DrawingArea.chs --- a/Graphics/UI/Gtk/Misc/DrawingArea.chs +++ b/Graphics/UI/Gtk/Misc/DrawingArea.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget DrawingArea -- diff --git a/Graphics/UI/Gtk/Misc/HandleBox.chs b/Graphics/UI/Gtk/Misc/HandleBox.chs --- a/Graphics/UI/Gtk/Misc/HandleBox.chs +++ b/Graphics/UI/Gtk/Misc/HandleBox.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget HandleBox -- diff --git a/Graphics/UI/Gtk/Misc/IMContextSimple.chs b/Graphics/UI/Gtk/Misc/IMContextSimple.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Misc/IMContextSimple.chs @@ -0,0 +1,99 @@ +{-# LANGUAGE CPP, ScopedTypeVariables #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget IMContextSimple +-- +-- Author : Andy Stewart +-- +-- Created: 24 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- An input method context supporting table-based input methods +-- +module Graphics.UI.Gtk.Misc.IMContextSimple ( + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----'IMContext' +-- | +----IMContextSimple +-- @ + +-- * Types + IMContextSimple, + IMContextSimpleClass, + castToIMContextSimple, + toIMContextSimple, + +-- * Constructors + imContextSimpleNew, + +-- * Methods + imContextSimpleAddTable, + ) where + +import Control.Monad (liftM) +import Data.Map (Map) + +import System.Glib.FFI +import System.Glib.UTFString +{#import Graphics.UI.Gtk.Types#} + +{# context lib="gtk" prefix="gtk" #} + +import qualified Data.Map as M + +-------------------- +-- Constructors + +-- | Creates a new 'IMContextSimple'. +-- +imContextSimpleNew :: IO IMContextSimple +imContextSimpleNew = + wrapNewGObject mkIMContextSimple $ + liftM castPtr {# call gtk_im_context_simple_new #} + +-------------------- +-- Methods + +-- | Adds an additional table to search to the input context. Each row of the table consists of +-- @maxSeqLen@ key symbols followed by two 'Int' interpreted as the high and low words of a gunicode +-- value. Tables are searched starting from the last added. +-- +-- The table must be sorted in dictionary order on the numeric value of the key symbol fields. (Values +-- beyond the length of the sequence should be zero.) +-- +imContextSimpleAddTable :: IMContextSimpleClass self => self + -> Map String String -- ^ @data@ - the table + -> Int -- ^ @maxSeqLen@ - Maximum length of a sequence in the table + -- (cannot be greater than 'MaxComposeLen') + -> Int -- ^ @nSeqs@ - number of sequences in the table + -> IO () +imContextSimpleAddTable self table maxSeqLen nSeqs = do + tableList <- mapM (\(x,y) -> do + nx <- newUTFString x + ny <- newUTFString y + return (nx, ny)) (M.toList table) + withArray (concatMap (\(x,y) -> [x, y]) tableList) $ \(tablePtr :: Ptr CString) -> + {# call gtk_im_context_simple_add_table #} + (toIMContextSimple self) + (castPtr tablePtr) + (fromIntegral maxSeqLen) + (fromIntegral nSeqs) diff --git a/Graphics/UI/Gtk/Misc/IMMulticontext.chs b/Graphics/UI/Gtk/Misc/IMMulticontext.chs --- a/Graphics/UI/Gtk/Misc/IMMulticontext.chs +++ b/Graphics/UI/Gtk/Misc/IMMulticontext.chs @@ -63,7 +63,7 @@ -- imMulticontextNew :: IO IMContext imMulticontextNew = - constructNewGObject mkIMContext $ + wrapNewGObject mkIMContext $ {# call im_multicontext_new #} -------------------- diff --git a/Graphics/UI/Gtk/Misc/SizeGroup.chs b/Graphics/UI/Gtk/Misc/SizeGroup.chs --- a/Graphics/UI/Gtk/Misc/SizeGroup.chs +++ b/Graphics/UI/Gtk/Misc/SizeGroup.chs @@ -91,7 +91,7 @@ import System.Glib.FFI import System.Glib.Attributes -import System.Glib.GObject (constructNewGObject) +import System.Glib.GObject (wrapNewGObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} @@ -107,7 +107,7 @@ SizeGroupMode -- ^ @mode@ - the mode for the new size group. -> IO SizeGroup sizeGroupNew mode = - constructNewGObject mkSizeGroup $ + wrapNewGObject mkSizeGroup $ {# call unsafe size_group_new #} ((fromIntegral . fromEnum) mode) diff --git a/Graphics/UI/Gtk/Misc/Tooltip.chs b/Graphics/UI/Gtk/Misc/Tooltip.chs --- a/Graphics/UI/Gtk/Misc/Tooltip.chs +++ b/Graphics/UI/Gtk/Misc/Tooltip.chs @@ -91,7 +91,12 @@ tooltipSetCustom, tooltipTriggerTooltipQuery, tooltipSetTipArea, +#ifdef HAVE_GIO +#if GTK_CHECK_VERSION(2,20,0) + tooltipSetIconFromGIcon, #endif +#endif +#endif ) where import Control.Monad (liftM) @@ -103,6 +108,9 @@ import Graphics.UI.Gtk.General.Structs (IconSize(..), Rectangle) import Graphics.Rendering.Pango.Markup {#import Graphics.UI.Gtk.Types#} +#ifdef HAVE_GIO +{#import System.GIO.Types#} +#endif {# context lib="gtk" prefix="gtk" #} @@ -217,4 +225,20 @@ {#call tooltip_set_tip_area#} (toTooltip self) (castPtr rectPtr) +#endif + +#ifdef HAVE_GIO +#if GTK_CHECK_VERSION(2,20,0) +-- | Sets the icon of the tooltip (which is in front of the text) to be the icon indicated by gicon with +-- the size indicated by size. If gicon is 'Nothing', the image will be hidden. +tooltipSetIconFromGIcon :: TooltipClass self => self + -> Maybe Icon -- ^ @gicon@ a GIcon representing the icon, or 'Nothing'. allow-none. + -> IconSize + -> IO () +tooltipSetIconFromGIcon tooltip icon size = + {#call gtk_tooltip_set_icon_from_gicon #} + (toTooltip tooltip) + (fromMaybe (Icon nullForeignPtr) icon) + ((fromIntegral . fromEnum) size) +#endif #endif diff --git a/Graphics/UI/Gtk/Misc/Viewport.chs b/Graphics/UI/Gtk/Misc/Viewport.chs --- a/Graphics/UI/Gtk/Misc/Viewport.chs +++ b/Graphics/UI/Gtk/Misc/Viewport.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Viewport -- @@ -53,6 +54,7 @@ -- * Types Viewport, ViewportClass, + ShadowType(..), castToViewport, gTypeViewport, toViewport, @@ -64,9 +66,14 @@ viewportGetVAdjustment, viewportSetHAdjustment, viewportSetVAdjustment, - ShadowType(..), viewportSetShadowType, viewportGetShadowType, +#if GTK_CHECK_VERSION(2,20,0) + viewportGetBinWindow, +#endif +#if GTK_CHECK_VERSION(2,22,0) + viewportGetViewWindow, +#endif -- * Attributes viewportHAdjustment, @@ -153,6 +160,30 @@ liftM (toEnum . fromIntegral) $ {# call unsafe viewport_get_shadow_type #} (toViewport self) + +#if GTK_CHECK_VERSION(2,20,0) +-- | Gets the bin window of the 'Viewport'. +-- +-- * Available since Gtk version 2.20 +-- +viewportGetBinWindow :: ViewportClass self => self -> IO DrawWindow +viewportGetBinWindow self = + makeNewGObject mkDrawWindow $ + {#call gtk_viewport_get_bin_window #} + (toViewport self) +#endif + +#if GTK_CHECK_VERSION(2,22,0) +-- | Gets the view window of the 'Viewport'. +-- +-- * Available since Gtk+ version 2.22 +-- +viewportGetViewWindow :: ViewportClass self => self -> IO DrawWindow +viewportGetViewWindow self = + makeNewGObject mkDrawWindow $ + {#call gtk_viewport_get_view_window #} + (toViewport self) +#endif -------------------- -- Attributes diff --git a/Graphics/UI/Gtk/ModelView/CellEditable.chs b/Graphics/UI/Gtk/ModelView/CellEditable.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/ModelView/CellEditable.chs @@ -0,0 +1,146 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Interface CellEditable +-- +-- Author : Andy Stewart +-- +-- Created: 26 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- Interface for widgets which can are used for editing cells +-- +module Graphics.UI.Gtk.ModelView.CellEditable ( + +-- * Detail +-- +-- | The 'CellEditable' interface must be implemented for widgets to be usable +-- when editing the contents of a 'TreeView' cell. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GInterface' +-- | +----CellEditable +-- @ + +-- * Types + CellEditable, + CellEditableClass, + castToCellEditable, + toCellEditable, + +-- * Methods + cellEditableStartEditing, + cellEditableEmitEditingDone, + cellEditableEmitRemoveWidget, + +-- * Attributes +#if GTK_CHECK_VERSION(2,20,0) + cellEditableEditingCanceled, +#endif + +-- * Signals + cellEditableEditingDone, + cellEditableRemoveWidget, + ) where + +import Control.Monad (liftM) +import Control.Monad.Reader.Class (ask) +import Control.Monad.Trans (liftIO) + +import System.Glib.FFI +import System.Glib.Attributes +import System.Glib.Properties +{#import Graphics.UI.Gtk.Types#} +{#import Graphics.UI.Gtk.Signals#} +import Graphics.UI.Gtk.Gdk.EventM (EventM, EKey, EAny) +import Graphics.UI.Gtk.Gdk.Events (Event, EventKey, marshalEvent) + +{# context lib="gtk" prefix="gtk" #} + +-------------------- +-- Methods + +-- | Begins editing on a @cellEditable@. @event@ is the 'Event' that began the editing process. +-- +cellEditableStartEditing :: CellEditableClass self => self -> EventM EAny () +cellEditableStartEditing self = do + eventPtr <- ask + liftIO $ {# call gtk_cell_editable_start_editing #} + (toCellEditable self) + (castPtr eventPtr) + +-- | Emits the 'cellEditableEditingDone' signal. +-- +cellEditableEmitEditingDone :: CellEditableClass self => self -> IO () +cellEditableEmitEditingDone self = + {# call gtk_cell_editable_editing_done #} + (toCellEditable self) + +-- | Emits the 'cellEditableRemoveWidget' signal. +-- +cellEditableEmitRemoveWidget :: CellEditableClass self => self -> IO () +cellEditableEmitRemoveWidget self = + {# call gtk_cell_editable_remove_widget #} + (toCellEditable self) + +-------------------- +-- Attributes +#if GTK_CHECK_VERSION(2,20,0) +-- | Indicates whether editing on the cell has been canceled. +-- +-- Default value: 'False' +-- +-- * Available since Gtk+ version 2.20 +-- +cellEditableEditingCanceled :: CellEditableClass self => Attr self Bool +cellEditableEditingCanceled = + newAttrFromBoolProperty "editing-canceled" +#endif + +-------------------- +-- Signals + +-- | This signal is a sign for the cell renderer to update its value from the +-- @cellEditable@. +-- +-- Implementations of 'CellEditable' are responsible for emitting this +-- signal when they are done editing, e.g. 'Entry' is emitting it when the user +-- presses Enter. +-- +-- 'cellEditableEmitEditingDone' is a convenience method for emitting +-- ::editing-done. +-- +cellEditableEditingDone :: CellEditableClass self => Signal self (IO ()) +cellEditableEditingDone = Signal (connect_NONE__NONE "editing_done") + +-- | This signal is meant to indicate that the cell is finished editing, and +-- the widget may now be destroyed. +-- +-- Implementations of 'CellEditable' are responsible for emitting this +-- signal when they are done editing. It must be emitted after the +-- 'cellEditableEditingDone' signal, to give the cell +-- renderer a chance to update the cell's value before the widget is removed. +-- +-- 'cellEditableEmitRemoveWidget' is a convenience method for emitting +-- ::remove-widget. +-- +cellEditableRemoveWidget :: CellEditableClass self => Signal self (IO ()) +cellEditableRemoveWidget = Signal (connect_NONE__NONE "remove_widget") diff --git a/Graphics/UI/Gtk/ModelView/CellLayout.chs b/Graphics/UI/Gtk/ModelView/CellLayout.chs --- a/Graphics/UI/Gtk/ModelView/CellLayout.chs +++ b/Graphics/UI/Gtk/ModelView/CellLayout.chs @@ -18,9 +18,6 @@ -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details. -- --- TODO: the following varargs functions were not bound --- gtk_cell_layout_set_attributes --- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional diff --git a/Graphics/UI/Gtk/ModelView/CellRendererAccel.chs b/Graphics/UI/Gtk/ModelView/CellRendererAccel.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/ModelView/CellRendererAccel.chs @@ -0,0 +1,170 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget CellRendererAccel +-- +-- Author : Andy Stewart +-- +-- Created: 25 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- Renders a keyboard accelerator in a cell +-- +-- * Module available since Gtk+ version 2.10 +-- +module Graphics.UI.Gtk.ModelView.CellRendererAccel ( + +-- * Detail +-- +-- | 'CellRendererAccel' displays a keyboard accelerator (i.e. a key +-- combination like \-a). If the cell renderer is editable, the +-- accelerator can be changed by simply typing the new combination. +-- +-- The 'CellRendererAccel' cell renderer was added in Gtk+ 2.10. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----'CellRenderer' +-- | +----'CellRendererText' +-- | +----CellRendererAccel +-- @ + +#if GTK_CHECK_VERSION(2,10,0) +-- * Types + CellRendererAccel, + CellRendererAccelClass, + castToCellRendererAccel, + toCellRendererAccel, + +-- * Enums + CellRendererAccelMode(..), + +-- * Constructors + cellRendererAccelNew, + +-- * Attributes + cellRendererAccelAccelKey, + cellRendererAccelAccelMods, + cellRendererAccelKeycode, + cellRendererAccelAccelMode, + +-- * Signals + accelEdited, + accelCleared, +#endif + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.Attributes +import System.Glib.Properties +import Graphics.UI.Gtk.Gdk.Enums (Modifier) +import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +import Graphics.UI.Gtk.Gdk.Keys (KeyVal, KeyCode) +{#import Graphics.UI.Gtk.Signals#} +{#import Graphics.UI.Gtk.Types#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,10,0) +-------------------- +-- Enums +{#enum CellRendererAccelMode {underscoreToCase} deriving (Bounded,Eq,Show)#} + +-------------------- +-- Constructors + +-- | Creates a new 'CellRendererAccel'. +-- +-- * Available since Gtk+ version 2.10 +-- +cellRendererAccelNew :: IO CellRendererAccel +cellRendererAccelNew = + makeNewObject mkCellRendererAccel $ liftM castPtr $ + {# call gtk_cell_renderer_accel_new #} + +-------------------- +-- Attributes + +-- | The keyval of the accelerator. +-- +-- Allowed values: <= GMaxint +-- +-- Default value: 0 +-- +-- * Available since Gtk+ version 2.10 +-- +cellRendererAccelAccelKey :: CellRendererAccelClass self => Attr self Int +cellRendererAccelAccelKey = newAttrFromUIntProperty "accel-key" + +-- | The modifier mask of the accelerator. +-- +-- * Available since Gtk+ version 2.10 +-- +cellRendererAccelAccelMods :: CellRendererAccelClass self => Attr self [Modifier] +cellRendererAccelAccelMods = newAttrFromFlagsProperty "accel-mods" + {# call pure unsafe gdk_modifier_type_get_type #} + +-- | The hardware keycode of the accelerator. Note that the hardware keycode is only relevant if the key +-- does not have a keyval. Normally, the keyboard configuration should assign keyvals to all keys. +-- +-- Allowed values: <= GMaxint +-- +-- Default value: 0 +-- +-- * Available since Gtk+ version 2.10 +-- +cellRendererAccelKeycode :: CellRendererAccelClass self => Attr self Int +cellRendererAccelKeycode = newAttrFromUIntProperty "keycode" + +-- | Determines if the edited accelerators are GTK+ accelerators. If they are, consumed modifiers are +-- suppressed, only accelerators accepted by GTK+ are allowed, and the accelerators are rendered in the +-- same way as they are in menus. +-- +-- Default value: 'CellRendererAccelModeGtk' +-- +-- * Available since Gtk+ version 2.10 +-- +cellRendererAccelAccelMode :: CellRendererAccelClass self => Attr self CellRendererAccelMode +cellRendererAccelAccelMode = newAttrFromEnumProperty "accel-mode" + {# call pure unsafe gtk_cell_renderer_accel_mode_get_type #} + +-------------------- +-- Signals + +-- | Gets emitted when the user has selected a new accelerator. +-- +-- * Available since Gtk+ version 2.10 +-- +accelEdited :: CellRendererAccelClass self => Signal self (String -> KeyVal -> Modifier -> KeyCode -> IO ()) +accelEdited = Signal (\after obj user -> connect_STRING_INT_ENUM_INT__NONE "accel_edited" after obj + (\ path keyval modifier keycode -> + user path (fromIntegral keyval) modifier (fromIntegral keycode))) + +-- | Gets emitted when the user has removed the accelerator. +-- +-- * Available since Gtk+ version 2.10 +-- +accelCleared :: CellRendererAccelClass self => Signal self (String -> IO ()) +accelCleared = Signal (connect_STRING__NONE "accel_cleared") +#endif diff --git a/Graphics/UI/Gtk/ModelView/CellRendererSpin.chs b/Graphics/UI/Gtk/ModelView/CellRendererSpin.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/ModelView/CellRendererSpin.chs @@ -0,0 +1,131 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget CellRendererSpin +-- +-- Author : Andy Stewart +-- +-- Created: 25 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- Renders a spin button in a cell +-- +-- * Module available since Gtk+ version 2.10 +-- +module Graphics.UI.Gtk.ModelView.CellRendererSpin ( + +-- * Detail +-- +-- | 'CellRendererSpin' renders text in a cell like 'CellRendererText' from +-- which it is derived. But while 'CellRendererText' offers a simple entry to +-- edit the text, 'CellRendererSpin' offers a 'SpinButton' widget. Of course, +-- that means that the text has to be parseable as a floating point number. +-- +-- The range of the spinbutton is taken from the adjustment property of the +-- cell renderer, which can be set explicitly or mapped to a column in the tree +-- model, like all properties of cell renders. 'CellRendererSpin' also has +-- properties for the climb rate and the number of digits to display. Other +-- 'SpinButton' properties can be set in a handler for the start-editing +-- signal. +-- +-- The 'CellRendererSpin' cell renderer was added in Gtk+ 2.10. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----'CellRenderer' +-- | +----'CellRendererText' +-- | +----CellRendererSpin +-- @ + +#if GTK_CHECK_VERSION(2,10,0) +-- * Types + CellRendererSpin, + CellRendererSpinClass, + castToCellRendererSpin, + toCellRendererSpin, + +-- * Constructors + cellRendererSpinNew, + +-- * Attributes + cellRendererSpinAdjustment, + cellRendererSpinClimbRate, + cellRendererSpinDigits, +#endif + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.Attributes +import System.Glib.Properties +import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +{#import Graphics.UI.Gtk.Types#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,10,0) +-------------------- +-- Constructors + +-- | Creates a new 'CellRendererSpin'. +-- +-- * Available since Gtk+ version 2.10 +-- +cellRendererSpinNew :: IO CellRendererSpin +cellRendererSpinNew = + makeNewObject mkCellRendererSpin $ liftM castPtr + {# call gtk_cell_renderer_spin_new #} + +-------------------- +-- Attributes + +-- | The adjustment that holds the value of the spinbutton. +-- +-- * Available since Gtk+ version 2.10 +-- +cellRendererSpinAdjustment :: CellRendererSpinClass self => Attr self Adjustment +cellRendererSpinAdjustment = newAttrFromObjectProperty "adjustment" + {# call pure unsafe gtk_adjustment_get_type #} + +-- | The acceleration rate when you hold down a button. +-- +-- Allowed values: >= 0 +-- +-- Default value: 0 +-- +-- * Available since Gtk+ version 2.10 +-- +cellRendererSpinClimbRate :: CellRendererSpinClass self => Attr self Double +cellRendererSpinClimbRate = newAttrFromDoubleProperty "climb-rate" + +-- | The number of decimal places to display. +-- +-- Allowed values: <= 20 +-- +-- Default value: 0 +-- +-- * Available since Gtk+ version 2.10 +-- +cellRendererSpinDigits :: CellRendererSpinClass self => Attr self Int +cellRendererSpinDigits = newAttrFromUIntProperty "digits" +#endif diff --git a/Graphics/UI/Gtk/ModelView/CellRendererSpinner.chs b/Graphics/UI/Gtk/ModelView/CellRendererSpinner.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/ModelView/CellRendererSpinner.chs @@ -0,0 +1,123 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget CellRendererSpinner +-- +-- Author : Andy Stewart +-- +-- Created: 25 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- Renders a spinning animation in a cell +-- +-- * Module available since Gtk+ version 2.20 +-- +module Graphics.UI.Gtk.ModelView.CellRendererSpinner ( +-- * Detail +-- | 'CellRendererSpinner' renders a spinning animation in a cell, very similar to 'Spinner'. It can +-- often be used as an alternative to a 'CellRendererProgress' for displaying indefinite activity, +-- instead of actual progress. +-- +-- To start the animation in a cell, set the "active" property to 'True' and increment the "pulse" +-- property at regular intervals. The usual way to set the cell renderer properties for each cell is +-- to bind them to columns in your tree model using e.g. 'treeViewColumnAddAttribute'. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----'CellRenderer' +-- | +----'CellRendererSpinner' +-- @ + +#if GTK_CHECK_VERSION(2,20,0) +-- * Types + CellRendererSpinner, + CellRendererSpinnerClass, + castToCellRendererSpinner, + toCellRendererSpinner, + +-- * Constructors + cellRendererSpinnerNew, + +-- * Attributes + cellRendererSpinnerActive, + cellRendererSpinnerPulse, + cellRendererSpinnerSize, +#endif +) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.Attributes +import System.Glib.Properties +import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +import Graphics.UI.Gtk.General.Structs (IconSize(..)) +{#import Graphics.UI.Gtk.Types#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,20,0) +-- | Returns a new cell renderer which will show a spinner to indicate activity. +-- +-- * Available since Gtk+ version 2.20 +-- +cellRendererSpinnerNew :: IO CellRendererSpinner +cellRendererSpinnerNew = + makeNewObject mkCellRendererSpinner $ liftM castPtr $ + {#call gtk_cell_renderer_spinner_new #} + +-- | Whether the spinner is active (ie. shown) in the cell. +-- +-- Default value: 'False' +-- +-- * Available since Gtk+ version 2.20 +-- +cellRendererSpinnerActive :: CellRendererSpinnerClass self => Attr self Bool +cellRendererSpinnerActive = + newAttrFromBoolProperty "active" + +-- | Pulse of the spinner. Increment this value to draw the next frame of the spinner animation. Usually, +-- you would update this value in a timeout. +-- +-- The 'Spinner' widget draws one full cycle of the animation per second by default. You can learn +-- about the number of frames used by the theme by looking at the 'numSteps' style property and the +-- duration of the cycle by looking at 'cycleDuration'. +-- +-- Default value: 0 +-- +-- * Available since Gtk+ version 2.20 +-- +cellRendererSpinnerPulse :: CellRendererSpinnerClass self => Attr self Int +cellRendererSpinnerPulse = + newAttrFromIntProperty "pulse" + +-- | The 'IconSize' value that specifies the size of the rendered spinner. +-- +-- Default value: 'IconSizeMenu' +-- +-- * Available since Gtk+ version 2.20 +-- +cellRendererSpinnerSize :: CellRendererSpinnerClass self => Attr self IconSize +cellRendererSpinnerSize = + newAttrFromEnumProperty "size" + {# call pure unsafe gtk_icon_size_get_type #} +#endif diff --git a/Graphics/UI/Gtk/ModelView/IconView.chs b/Graphics/UI/Gtk/ModelView/IconView.chs --- a/Graphics/UI/Gtk/ModelView/IconView.chs +++ b/Graphics/UI/Gtk/ModelView/IconView.chs @@ -108,6 +108,10 @@ iconViewSetReorderable, iconViewGetReorderable, #endif +#if GTK_CHECK_VERSION(2,22,0) + iconViewGetItemRow, + iconViewGetItemColumn, +#endif -- * Attributes iconViewSelectionMode, @@ -125,6 +129,9 @@ #if GTK_CHECK_VERSION(2,8,0) iconViewReorderable, #endif +#if GTK_CHECK_VERSION(2,22,0) + iconViewItemOrientation, +#endif -- * Signals setIconViewScrollAdjustments, @@ -822,6 +829,37 @@ #endif +#if GTK_CHECK_VERSION(2,22,0) +-- | Gets the row in which the item path is currently displayed. Row numbers start at 0. +-- +-- * Available since Gtk+ version 2.22 +-- +iconViewGetItemRow :: IconViewClass self => self + -> TreePath -- ^ @path@ the 'TreePath' of the item + -> IO Int -- ^ returns The row in which the item is displayed +iconViewGetItemRow self path = + liftM fromIntegral $ + withTreePath path $ \path -> + {# call gtk_icon_view_get_item_row #} + (toIconView self) + path + +-- | Gets the column in which the item path is currently displayed. Column numbers start at 0. +-- +-- * Available since Gtk+ version 2.22 +-- +iconViewGetItemColumn :: IconViewClass self => self + -> TreePath -- ^ @path@ the 'TreePath' of the item + -> IO Int -- ^ returns The column in which the item is displayed +iconViewGetItemColumn self path = + liftM fromIntegral $ + withTreePath path $ \path -> + {# call gtk_icon_view_get_item_column #} + (toIconView self) + path + +#endif + -------------------- -- Attributes @@ -973,6 +1011,19 @@ iconViewReorderable = newAttrFromBoolProperty "reorderable" #endif +#if GTK_CHECK_VERSION(2,22,0) +-- | The item-orientation property specifies how the cells (i.e. the icon and the text) of the item are +-- positioned relative to each other. +-- +-- Default value: 'OrientationVertical' +-- +-- * Available since Gtk+ version 2.22 +-- +iconViewItemOrientation :: IconViewClass self => Attr self Orientation +iconViewItemOrientation = newAttrFromEnumProperty "item-orientation" + {# call pure unsafe gtk_orientation_get_type #} +#endif + -------------------- -- Signals @@ -980,13 +1031,13 @@ -- | New scroll adjustment have been set for this widget. -- setIconViewScrollAdjustments :: IconViewClass self => Signal self (Adjustment -> Adjustment -> IO ()) -setIconViewScrollAdjustments = Signal (connect_OBJECT_OBJECT__NONE "set_scroll_adjustments") +setIconViewScrollAdjustments = Signal (connect_OBJECT_OBJECT__NONE "set-scroll-adjustments") -- %hash c:4090 d:af3f -- | A specific element has been activated (by pressing enter or double clicking). -- itemActivated :: IconViewClass self => Signal self (TreePath -> IO ()) -itemActivated = Signal (connect_BOXED__NONE "item_activated" (peekTreePath . castPtr)) +itemActivated = Signal (connect_BOXED__NONE "item-activated" (peekTreePath . castPtr)) -- %hash c:6098 d:af3f -- | The selected item changed. diff --git a/Graphics/UI/Gtk/ModelView/ListStore.hs b/Graphics/UI/Gtk/ModelView/ListStore.hs --- a/Graphics/UI/Gtk/ModelView/ListStore.hs +++ b/Graphics/UI/Gtk/ModelView/ListStore.hs @@ -259,8 +259,6 @@ when (index >=0 && index < Seq.length seq) $ do writeIORef (customStoreGetPrivate model) (delete index seq) treeModelRowDeleted model [index] - --TODO we should probably fail on a bad index - where delete :: Int -> Seq a -> Seq a delete i xs = front Seq.>< Seq.drop 1 back where (front, back) = Seq.splitAt i xs diff --git a/Graphics/UI/Gtk/ModelView/TreeDrag.chs b/Graphics/UI/Gtk/ModelView/TreeDrag.chs --- a/Graphics/UI/Gtk/ModelView/TreeDrag.chs +++ b/Graphics/UI/Gtk/ModelView/TreeDrag.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Interface DragSource and DragDest -- diff --git a/Graphics/UI/Gtk/ModelView/TreeModel.chs b/Graphics/UI/Gtk/ModelView/TreeModel.chs --- a/Graphics/UI/Gtk/ModelView/TreeModel.chs +++ b/Graphics/UI/Gtk/ModelView/TreeModel.chs @@ -610,21 +610,21 @@ -- | This signal is emitted when a row in the model has changed. -- rowChanged :: TreeModelClass self => Signal self (TreePath -> TreeIter -> IO ()) -rowChanged = Signal (connect_BOXED_BOXED__NONE "row_changed" peekTreePath peekTreeIter) +rowChanged = Signal (connect_BOXED_BOXED__NONE "row-changed" peekTreePath peekTreeIter) -- %hash c:f31a d:3c6b -- | This signal is emitted when a new row has been inserted in the model. -- -- rowInserted :: TreeModelClass self => Signal self (TreePath -> TreeIter -> IO ()) -rowInserted = Signal (connect_BOXED_BOXED__NONE "row_inserted" peekTreePath peekTreeIter) +rowInserted = Signal (connect_BOXED_BOXED__NONE "row-inserted" peekTreePath peekTreeIter) -- %hash c:7279 d:5ef -- | This signal is emitted when a row has gotten the first child row or lost -- its last child row. -- rowHasChildToggled :: TreeModelClass self => Signal self (TreePath -> TreeIter -> IO ()) -rowHasChildToggled = Signal (connect_BOXED_BOXED__NONE "row_has_child_toggled" peekTreePath peekTreeIter) +rowHasChildToggled = Signal (connect_BOXED_BOXED__NONE "row-has-child-toggled" peekTreePath peekTreeIter) -- %hash c:f669 d:367f -- | This signal is emitted when a row has been deleted. @@ -638,7 +638,7 @@ -- need to be released in the 'rowDeleted' handler. -- rowDeleted :: TreeModelClass self => Signal self (TreePath -> IO ()) -rowDeleted = Signal (connect_BOXED__NONE "row_deleted" peekTreePath) +rowDeleted = Signal (connect_BOXED__NONE "row-deleted" peekTreePath) -- %hash c:46dd d:b2e5 -- | This signal is emitted when the children of a node in the 'TreeModel' @@ -651,7 +651,7 @@ rowsReordered :: TreeModelClass self => Signal self (TreePath -> Maybe TreeIter -> [Int] -> IO ()) rowsReordered = Signal $ \after model user -> - connect_BOXED_BOXED_PTR__NONE "rows_reordered" peekTreePath + connect_BOXED_BOXED_PTR__NONE "rows-reordered" peekTreePath (maybePeek peekTreeIter) after model $ \path iter arrayPtr -> do n <- treeModelIterNChildren model iter -- hopefully the model is never buggy, otherwise this can segfault diff --git a/Graphics/UI/Gtk/ModelView/TreeModelFilter.chs b/Graphics/UI/Gtk/ModelView/TreeModelFilter.chs --- a/Graphics/UI/Gtk/ModelView/TreeModelFilter.chs +++ b/Graphics/UI/Gtk/ModelView/TreeModelFilter.chs @@ -82,7 +82,7 @@ import Control.Monad (liftM) import System.Glib.FFI -import System.Glib.GObject (constructNewGObject) +import System.Glib.GObject (wrapNewGObject) import System.Glib.Attributes import System.Glib.Properties {#import Graphics.UI.Gtk.Types#} @@ -116,14 +116,14 @@ -> IO (TypedTreeModelFilter row) treeModelFilterNew childModel [] = liftM unsafeTreeModelFilterToGeneric $ - constructNewGObject mkTreeModelFilter $ + wrapNewGObject mkTreeModelFilter $ liftM (castPtr :: Ptr TreeModel -> Ptr TreeModelFilter) $ {# call gtk_tree_model_filter_new #} (toTreeModel childModel) (NativeTreePath nullPtr) treeModelFilterNew childModel root = liftM unsafeTreeModelFilterToGeneric $ - constructNewGObject mkTreeModelFilter $ + wrapNewGObject mkTreeModelFilter $ liftM (castPtr :: Ptr TreeModel -> Ptr TreeModelFilter) $ withTreePath root $ \root -> {# call gtk_tree_model_filter_new #} @@ -148,13 +148,9 @@ -- up to date. -- treeModelFilterSetVisibleFunc :: TreeModelFilterClass self => self - -> Maybe (TreeIter -> IO Bool) -- ^ @func@ - The visible function or - -- @Nothing@ to reset this function. + -> (TreeIter -> IO Bool) -- ^ @func@ - The visible function -> IO () -treeModelFilterSetVisibleFunc self Nothing = - {# call gtk_tree_model_filter_set_visible_func #} - (toTreeModelFilter self) nullFunPtr nullPtr nullFunPtr -treeModelFilterSetVisibleFunc self (Just func) = do +treeModelFilterSetVisibleFunc self func = do funcPtr <- mkTreeModelFilterVisibleFunc $ \_ tiPtr _ -> do ti <- peekTreeIter tiPtr liftM fromBool $ func ti diff --git a/Graphics/UI/Gtk/ModelView/TreeModelSort.chs b/Graphics/UI/Gtk/ModelView/TreeModelSort.chs --- a/Graphics/UI/Gtk/ModelView/TreeModelSort.chs +++ b/Graphics/UI/Gtk/ModelView/TreeModelSort.chs @@ -69,8 +69,7 @@ import Control.Monad (liftM) import System.Glib.FFI -import System.Glib.GObject (constructNewGObject, - makeNewGObject) +import System.Glib.GObject (wrapNewGObject, makeNewGObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.ModelView.TreeModel#} {#import Graphics.UI.Gtk.ModelView.Types#} @@ -95,7 +94,7 @@ TypedTreeModelClass childModel) => childModel row -> IO (TypedTreeModelSort row) treeModelSortNewWithModel childModel = liftM unsafeTreeModelSortToGeneric $ - constructNewGObject mkTreeModelSort $ + wrapNewGObject mkTreeModelSort $ liftM (castPtr :: Ptr TreeModel -> Ptr TreeModelSort) $ {# call tree_model_sort_new_with_model #} (toTreeModel childModel) diff --git a/Graphics/UI/Gtk/ModelView/TreeSelection.chs b/Graphics/UI/Gtk/ModelView/TreeSelection.chs --- a/Graphics/UI/Gtk/ModelView/TreeSelection.chs +++ b/Graphics/UI/Gtk/ModelView/TreeSelection.chs @@ -95,8 +95,13 @@ treeSelectionMode, -- * Signals + treeSelectionSelectionChanged, + +#ifndef DISABLE_DEPRECATED +-- * Deprecated onSelectionChanged, afterSelectionChanged +#endif ) where import Control.Monad (liftM) @@ -379,8 +384,16 @@ -- rows are selected, and it may occasionally be emitted when nothing has -- happened. -- +treeSelectionSelectionChanged :: TreeSelectionClass self => Signal self (IO ()) +treeSelectionSelectionChanged = Signal (connect_NONE__NONE "changed") + +#ifndef DISABLE_DEPRECATED +-------------------- +-- Deprecated Signals + onSelectionChanged, afterSelectionChanged :: TreeSelectionClass self => self -> IO () -> IO (ConnectId self) onSelectionChanged = connect_NONE__NONE "changed" False afterSelectionChanged = connect_NONE__NONE "changed" True +#endif diff --git a/Graphics/UI/Gtk/ModelView/TreeSortable.chs b/Graphics/UI/Gtk/ModelView/TreeSortable.chs --- a/Graphics/UI/Gtk/ModelView/TreeSortable.chs +++ b/Graphics/UI/Gtk/ModelView/TreeSortable.chs @@ -183,11 +183,20 @@ -- 'treeSortableDefaultSortColumnId' then the model will sort using -- this function. -- +-- | If @sortFunc@ is 'Nothing', then there will be no default comparison function. +-- This means that once the +-- model has been sorted, it can't go back to the default state. In this case, when the current sort +-- column id of sortable is 'TreeSortableDefaultSortColumnId', the model will be unsorted. treeSortableSetDefaultSortFunc :: TreeSortableClass self => self - -> (TreeIter -> TreeIter -> IO Ordering) + -> Maybe (TreeIter -> TreeIter -> IO Ordering) -- ^ @sortFunc@ - The comparison function + -- or 'Nothing' to use default comparison function. -> IO () -treeSortableSetDefaultSortFunc self sortFunc = do +treeSortableSetDefaultSortFunc self Nothing = do + {# call tree_sortable_set_default_sort_func #} + (toTreeSortable self) + nullFunPtr nullPtr nullFunPtr +treeSortableSetDefaultSortFunc self (Just sortFunc) = do fPtr <- mkTreeIterCompareFunc (\_ iter1Ptr iter2Ptr _ -> do iter1 <- peek iter1Ptr iter2 <- peek iter2Ptr @@ -224,4 +233,4 @@ -- | -- sortColumnChanged :: TreeSortableClass self => Signal self (IO ()) -sortColumnChanged = Signal (connect_NONE__NONE "sort_column_changed") +sortColumnChanged = Signal (connect_NONE__NONE "sort-column-changed") diff --git a/Graphics/UI/Gtk/ModelView/TreeStore.hs b/Graphics/UI/Gtk/ModelView/TreeStore.hs --- a/Graphics/UI/Gtk/ModelView/TreeStore.hs +++ b/Graphics/UI/Gtk/ModelView/TreeStore.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) CustomStore TreeModel -- @@ -250,11 +251,11 @@ iterPrefixEqual :: TreeIter -> TreeIter -> Int -> Bool iterPrefixEqual (TreeIter _ a1 b1 c1) (TreeIter _ a2 b2 c2) pos | pos>64 = let mask = 1 `shiftL` (pos-64) - 1 in - a1==a2 && b1==b2 && (c1 .&. mask) == (c2 .&. mask) + a1==a2 && b1==b2 && (c1 .&. mask) == (c2 .&. mask) | pos>32 = let mask = 1 `shiftL` (pos-32) - 1 in - a1==a2 && (b1 .&. mask) == (b2 .&. mask) + a1==a2 && (b1 .&. mask) == (b2 .&. mask) | otherwise = let mask = 1 `shiftL` pos - 1 in - (a1 .&. mask) == (a2 .&. mask) + (a1 .&. mask) == (a2 .&. mask) -- | The invalid tree iterator. -- @@ -270,8 +271,8 @@ -- calcForestDepth :: Forest a -> Depth calcForestDepth f = map bitsNeeded $ - takeWhile (/=0) $ - foldr calcTreeDepth (repeat 0) f + takeWhile (/=0) $ + foldr calcTreeDepth (repeat 0) f where calcTreeDepth Node { subForest = f } (d:ds) = (d+1): zipWith max ds (foldr calcTreeDepth (repeat 0) f) @@ -284,7 +285,7 @@ where gP pos [] = [] gP pos (d:ds) = let idx = getBitSlice iter pos d in - if idx==0 then [] else fromIntegral (idx-1) : gP (pos+d) ds + if idx==0 then [] else fromIntegral (idx-1) : gP (pos+d) ds -- | Try to convert a path into a 'TreeIter'. -- @@ -304,7 +305,7 @@ -- for which this lookup was started and the innermost frame (the last -- element of the list) contains the root of the tree. -- -type Cache a = [(TreeIter, Forest a)] +type Cache a = [(TreeIter, Forest a)] -- | Create a traversal structure that allows a pre-order traversal in linear @@ -329,7 +330,7 @@ -- advanceCache :: Depth -> TreeIter -> Cache a -> Cache a advanceCache depth goal [] = [] -advanceCache depth goal cache@((rootIter,_):_) = +advanceCache depth goal cache@((rootIter,_):_) = moveToSameLevel 0 depth where moveToSameLevel pos [] = cache @@ -348,16 +349,16 @@ -- advance the current iterator to coincide with the goal iterator -- at this level moveWithinLevel pos d ((ti,forest):parents) = let - diff = fromIntegral (goalIdx-curIdx) - (dropped, remain) = splitAt diff forest - advance = length dropped - ti' = setBitSlice ti pos d (curIdx+fromIntegral advance) - in - if advance==diff then moveToChild (pos+d) ds ((ti',remain):parents) - else (ti',remain):parents -- node not found + diff = fromIntegral (goalIdx-curIdx) + (dropped, remain) = splitAt diff forest + advance = length dropped + ti' = setBitSlice ti pos d (curIdx+fromIntegral advance) + in + if advance==diff then moveToChild (pos+d) ds ((ti',remain):parents) + else (ti',remain):parents -- node not found in moveWithinLevel pos d $ case ds of [] -> cache - (d':_) -> dropWhile (isNonZero (pos+d) d') cache + (d':_) -> dropWhile (isNonZero (pos+d) d') cache -- Descend into the topmost forest to find the goal iterator. The position -- and the remainding depths specify the index in the cache that is zero. @@ -370,16 +371,16 @@ [] -> cache -- impossible request Node { subForest = children }:_ -> let - childIdx :: Int - childIdx = fromIntegral (getBitSlice goal pos d)-1 - (dropped, remain) = splitAt childIdx children - advanced = length dropped - ti' = setBitSlice ti pos d (fromIntegral advanced+1) - in if advanced TreeIter -> Cache a -> (Bool, Cache a) checkSuccess depth iter cache = case advanceCache depth iter cache of cache'@((cur,sibs):_) -> (cmp cur iter && not (null sibs), cache') @@ -422,7 +423,7 @@ -- | Move down to the child of the given iterator. -- iterNthChild :: Depth -> Int -> TreeIter -> Cache a -> - (Maybe TreeIter, Cache a) + (Maybe TreeIter, Cache a) iterNthChild depth childIdx_ iter cache = let (pos,leaf,child) = getTreeIterLeaf depth iter childIdx = fromIntegral childIdx_+1 :: Word @@ -523,7 +524,7 @@ -- of the parent. -- insertIntoForest :: Forest a -> Forest a -> TreePath -> Int -> - Maybe (Forest a, Int, Bool) + Maybe (Forest a, Int, Bool) insertIntoForest forest nodes [] pos | pos<0 = Just (forest++nodes, length forest, null forest) | otherwise = Just (prev++nodes++next, length prev, null forest) @@ -531,13 +532,13 @@ insertIntoForest forest nodes (p:ps) pos = case splitAt p forest of (prev, []) -> Nothing (prev, Node { rootLabel = val, - subForest = for}:next) -> + subForest = for}:next) -> case insertIntoForest for nodes ps pos of Nothing -> Nothing Just (for, pos, toggle) -> Just (prev++Node { rootLabel = val, - subForest = for }:next, - pos, toggle) - + subForest = for }:next, + pos, toggle) + -- | Remove a node from the store. -- -- * The node denoted by the path is removed, along with all its children. @@ -555,12 +556,12 @@ Nothing -> (store, (False, False)) Just (newForest, toggle) -> (Store { depth = d, -- this might be a space leak - content = storeToCache newForest }, (True, toggle)) + content = storeToCache newForest }, (True, toggle)) when found $ do when (toggle && not (null path)) $ do Store { depth = depth } <- readIORef (customStoreGetPrivate model) let parent = init path - Just iter = fromPath depth parent + Just iter = fromPath depth parent treeModelRowHasChildToggled model parent iter treeModelRowDeleted model path return found @@ -588,12 +589,12 @@ deleteFromForest forest (p:ps) = case splitAt p forest of (prev, kill@Node { rootLabel = val, - subForest = for}:next) -> + subForest = for}:next) -> if null ps then Just (prev++next, null prev && null next) else case deleteFromForest for ps of Nothing -> Nothing - Just (for,toggle) -> Just (prev++Node {rootLabel = val, - subForest = for }:next, toggle) + Just (for,toggle) -> Just (prev++Node {rootLabel = val, + subForest = for }:next, toggle) (prev, []) -> Nothing @@ -621,14 +622,14 @@ treeStoreChangeM :: TreeStore a -> TreePath -> (a -> IO a) -> IO Bool treeStoreChangeM (TreeStore model) path act = do customStoreInvalidateIters model - store@Store { depth = d, content = cache } <- + store@Store { depth = d, content = cache } <- readIORef (customStoreGetPrivate model) (store'@Store { depth = d, content = cache }, found) <- do mRes <- changeForest (cacheToStore cache) act path return $ case mRes of Nothing -> (store, False) Just newForest -> (Store { depth = d, - content = storeToCache newForest }, True) + content = storeToCache newForest }, True) writeIORef (customStoreGetPrivate model) store' let Just iter = fromPath d path stamp <- customStoreGetStamp model @@ -644,17 +645,17 @@ changeForest forest act (p:ps) = case splitAt p forest of (prev, []) -> return Nothing (prev, Node { rootLabel = val, - subForest = for}:next) -> + subForest = for}:next) -> if null ps then do val' <- act val return (Just (prev++Node { rootLabel = val', - subForest = for }:next)) + subForest = for }:next)) else do mFor <- changeForest for act ps case mFor of Nothing -> return Nothing - Just for -> return $ Just (prev++Node { rootLabel = val, - subForest = for }:next) + Just for -> return $ Just (prev++Node { rootLabel = val, + subForest = for }:next) -- | Extract one node from the current model. Fails if the given -- 'TreePath' refers to a non-existent node. @@ -667,7 +668,7 @@ -- treeStoreGetTree :: TreeStore a -> TreePath -> IO (Tree a) treeStoreGetTree (TreeStore model) path = do - store@Store { depth = d, content = cache } <- + store@Store { depth = d, content = cache } <- readIORef (customStoreGetPrivate model) case fromPath d path of (Just iter) -> do @@ -683,7 +684,7 @@ -- treeStoreLookup :: TreeStore a -> TreePath -> IO (Maybe (Tree a)) treeStoreLookup (TreeStore model) path = do - store@Store { depth = d, content = cache } <- + store@Store { depth = d, content = cache } <- readIORef (customStoreGetPrivate model) case fromPath d path of (Just iter) -> do diff --git a/Graphics/UI/Gtk/ModelView/TreeView.chs b/Graphics/UI/Gtk/ModelView/TreeView.chs --- a/Graphics/UI/Gtk/ModelView/TreeView.chs +++ b/Graphics/UI/Gtk/ModelView/TreeView.chs @@ -220,6 +220,7 @@ cursorChanged, rowCollapsed, rowExpanded, + rowActivated, testCollapseRow, testExpandRow, @@ -256,7 +257,7 @@ import System.Glib.Flags import System.Glib.Attributes import System.Glib.Properties -import System.Glib.GObject (makeNewGObject, constructNewGObject, +import System.Glib.GObject (makeNewGObject, wrapNewGObject, destroyFunPtr) import Graphics.UI.Gtk.Gdk.Enums (DragAction(..)) import Graphics.UI.Gtk.Gdk.Events (Modifier(..)) @@ -1112,7 +1113,7 @@ -> TreePath -> IO Pixmap treeViewCreateRowDragIcon self path = - constructNewGObject mkPixmap $ + wrapNewGObject mkPixmap $ withTreePath path $ \path -> {# call unsafe tree_view_create_row_drag_icon #} (toTreeView self) @@ -1762,6 +1763,13 @@ -- rowExpanded :: TreeViewClass self => Signal self (TreeIter -> TreePath -> IO ()) rowExpanded = Signal (connect_BOXED_BOXED__NONE "row-expanded" peek readNTP) + +-- | A row was activated. +-- +-- * Activation usually means the user has pressed return on a row. +-- +rowActivated :: TreeViewClass self => Signal self (TreePath -> TreeViewColumn -> IO ()) +rowActivated = Signal (connect_BOXED_OBJECT__NONE "row-activated" readNTP) -- %hash c:9ee6 d:325e -- | The given row has been collapsed (child nodes are hidden). 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 @@ -79,9 +79,13 @@ textBufferGetCharCount, textBufferGetTagTable, textBufferInsert, + textBufferInsertByteString, textBufferInsertAtCursor, + textBufferInsertByteStringAtCursor, textBufferInsertInteractive, + textBufferInsertByteStringInteractive, textBufferInsertInteractiveAtCursor, + textBufferInsertByteStringInteractiveAtCursor, textBufferInsertRange, textBufferInsertRangeInteractive, textBufferDelete, @@ -197,7 +201,7 @@ import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties -import System.Glib.GObject (constructNewGObject, +import System.Glib.GObject (wrapNewGObject, makeNewGObject) import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCStringLen, unsafePackCStringFinalizer) @@ -219,7 +223,7 @@ -- new one -> IO TextBuffer textBufferNew table = - constructNewGObject mkTextBuffer $ + wrapNewGObject mkTextBuffer $ {# call unsafe text_buffer_new #} (maybe (TextTagTable nullForeignPtr) toTextTagTable table) @@ -253,7 +257,7 @@ (toTextBuffer self) -- | Inserts @text@ at position @iter@. Emits the --- \"insert_text\" signal; insertion actually occurs in the default handler for +-- 'insertText' signal; insertion actually occurs in the default handler for -- the signal. @iter@ is invalidated when insertion occurs (because the buffer -- contents change). -- @@ -269,6 +273,23 @@ textPtr (fromIntegral len) +-- | Inserts @text@ at position @iter@. Similar +-- to 'textBufferInsert' but uses 'ByteString' buffers. +-- +-- * The passed-in buffer must contain a valid UTF-8 encoded string. +-- +textBufferInsertByteString :: TextBufferClass self => self + -> TextIter -- ^ @iter@ - a position in the buffer + -> ByteString -- ^ @text@ - text to insert + -> IO () +textBufferInsertByteString self iter text = + unsafeUseAsCStringLen text $ \(textPtr, len) -> + {# call text_buffer_insert #} + (toTextBuffer self) + iter + textPtr + (fromIntegral len) + -- | Simply calls 'textBufferInsert', using the current cursor position as the -- insertion point. -- @@ -280,6 +301,19 @@ textPtr (fromIntegral len) +-- | Simply calls 'textBufferInsert', using the current cursor position as the +-- insertion point. Similar to 'textBufferInsertAtCursor' but uses 'ByteString' buffers. +-- +-- * The passed-in buffer must contain a valid UTF-8 encoded string. +-- +textBufferInsertByteStringAtCursor :: TextBufferClass self => self -> ByteString -> IO () +textBufferInsertByteStringAtCursor self text = + unsafeUseAsCStringLen text $ \(textPtr, len) -> + {# call text_buffer_insert_at_cursor #} + (toTextBuffer self) + textPtr + (fromIntegral len) + -- | Like 'textBufferInsert', but the insertion will not occur if @iter@ is at -- a non-editable location in the buffer. Usually you want to prevent -- insertions at ineditable locations if the insertion results from a user @@ -304,6 +338,25 @@ (fromIntegral len) (fromBool defaultEditable) +-- | Similar to 'textBufferInsertInteractive' but uses 'ByteString' buffers. +-- +-- * The passed-in buffer must contain a valid UTF-8 encoded string. +-- +textBufferInsertByteStringInteractive :: TextBufferClass self => self + -> TextIter -- ^ @iter@ - a position in @buffer@ + -> ByteString -- ^ @text@ - the text to insert + -> Bool -- ^ @defaultEditable@ - default editability of buffer + -> IO Bool -- ^ returns whether text was actually inserted +textBufferInsertByteStringInteractive self iter text defaultEditable = + liftM toBool $ + unsafeUseAsCStringLen text $ \(textPtr, len) -> + {# call text_buffer_insert_interactive #} + (toTextBuffer self) + iter + textPtr + (fromIntegral len) + (fromBool defaultEditable) + -- | Calls 'textBufferInsertInteractive' at the cursor position. -- textBufferInsertInteractiveAtCursor :: TextBufferClass self => self @@ -319,13 +372,30 @@ (fromIntegral len) (fromBool defaultEditable) +-- | Similar to 'textBufferInsertInteractiveAtCursor' but uses 'ByteString' buffers. +-- +-- * The passed-in buffer must contain a valid UTF-8 encoded string. +-- +textBufferInsertByteStringInteractiveAtCursor :: TextBufferClass self => self + -> ByteString -- ^ @text@ - the text to insert + -> Bool -- ^ @defaultEditable@ - default editability of buffer + -> IO Bool -- ^ returns whether text was actually inserted +textBufferInsertByteStringInteractiveAtCursor self text defaultEditable = + liftM toBool $ + unsafeUseAsCStringLen text $ \(textPtr, len) -> + {# call text_buffer_insert_interactive_at_cursor #} + (toTextBuffer self) + textPtr + (fromIntegral len) + (fromBool defaultEditable) + -- | Copies text, tags, and pixbufs between @start@ and @end@ (the order of -- @start@ and @end@ doesn't matter) and inserts the copy at @iter@. Used -- instead of simply getting\/inserting text because it preserves images and -- tags. If @start@ and @end@ are in a different buffer from @buffer@, the two -- buffers must share the same tag table. -- --- Implemented via emissions of the insert-text and apply-tag signals, so +-- Implemented via emissions of the insert-text and 'applyTag' signals, so -- expect those. -- textBufferInsertRange :: TextBufferClass self => self @@ -363,7 +433,7 @@ -- | Deletes text between @start@ and @end@. The order of @start@ and @end@ is -- not actually relevant; 'textBufferDelete' will reorder them. This function --- actually emits the \"delete_range\" signal, and the default handler of that +-- actually emits the 'deleteRange' signal, and the default handler of that -- signal deletes the text. Because the buffer is modified, all outstanding -- iterators become invalid after calling this function; however, the @start@ -- and @end@ will be re-initialized to point to the location where text was @@ -534,7 +604,7 @@ -- standard left-to-right cursor is a mark with right gravity (when you type, -- the cursor stays on the right side of the text you're typing). -- --- Emits the \"mark_set\" signal as notification of the mark's initial +-- Emits the 'markSet' signal as notification of the mark's initial -- placement. -- textBufferCreateMark :: TextBufferClass self => self @@ -598,7 +668,7 @@ -- return @True@ after this function has been -- called on a mark; 'Graphics.UI.Gtk.Multiline.TextMark.textMarkGetDeleted' -- indicates that a mark no longer --- belongs to a buffer. The \"mark_deleted\" signal will be emitted as +-- belongs to a buffer. The 'markDeleted' signal will be emitted as -- notification after the mark is deleted. -- textBufferDeleteMark :: (TextBufferClass self, TextMarkClass mark) => self @@ -676,7 +746,7 @@ (toTextBuffer self) where_ --- | Emits the \"apply_tag\" signal on the buffer. The default handler for the +-- | Emits the 'applyTag' signal on the buffer. The default handler for the -- signal applies @tag@ to the given range. @start@ and @end@ do not have to be -- in order. -- @@ -692,7 +762,7 @@ start end --- | Emits the \"remove_tag\" signal. The default handler for the signal +-- | Emits the 'removeTag' signal. The default handler for the signal -- removes all occurrences of @tag@ from the given range. @start@ and @end@ -- don't have to be in order. -- @@ -859,7 +929,7 @@ -- time it was saved. Whenever the buffer is saved to disk, call -- @'textBufferSetModified' buffer False@. When the buffer is -- modified, it will automatically toggled on the modified bit again. When the --- modified bit flips, the buffer emits a \"modified_changed\" signal. +-- modified bit flips, the buffer emits a 'modifiedChanged' signal. -- textBufferSetModified :: TextBufferClass self => self -> Bool -> IO () textBufferSetModified self setting = @@ -915,8 +985,8 @@ -- operations between 'textBufferBeginUserAction' and 'textBufferEndUserAction' -- can then be grouped when creating an undo stack. 'TextBuffer' maintains a -- count of calls to 'textBufferBeginUserAction' that have not been closed with --- a call to 'textBufferEndUserAction', and emits the \"begin_user_action\" and --- \"end_user_action\" signals only for the outermost pair of calls. This +-- a call to 'textBufferEndUserAction', and emits the 'beginUserAction' and +-- 'endUserAction' signals only for the outermost pair of calls. This -- allows you to build user actions from other user actions. -- -- The \"interactive\" buffer mutation functions, such as diff --git a/Graphics/UI/Gtk/Multiline/TextMark.chs b/Graphics/UI/Gtk/Multiline/TextMark.chs --- a/Graphics/UI/Gtk/Multiline/TextMark.chs +++ b/Graphics/UI/Gtk/Multiline/TextMark.chs @@ -89,7 +89,7 @@ import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties -import System.Glib.GObject (makeNewGObject) +import System.Glib.GObject (makeNewGObject, wrapNewGObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} @@ -118,7 +118,7 @@ -> Bool -- ^ @leftGravity@ - whether the mark has left gravity -> IO TextMark textMarkNew markName leftGravity = - makeNewGObject mkTextMark $ + wrapNewGObject mkTextMark $ maybeWith withUTFString markName $ \markNamePtr -> {# call text_mark_new #} markNamePtr diff --git a/Graphics/UI/Gtk/Multiline/TextTag.chs b/Graphics/UI/Gtk/Multiline/TextTag.chs --- a/Graphics/UI/Gtk/Multiline/TextTag.chs +++ b/Graphics/UI/Gtk/Multiline/TextTag.chs @@ -155,7 +155,7 @@ import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties -import System.Glib.GObject (constructNewGObject) +import System.Glib.GObject (wrapNewGObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.Rendering.Pango.Font @@ -183,12 +183,12 @@ -- textTagNew :: Maybe TagName -> IO TextTag textTagNew (Just name) = - constructNewGObject mkTextTag $ + wrapNewGObject mkTextTag $ withCString name $ \namePtr -> {# call unsafe text_tag_new #} namePtr textTagNew Nothing = - constructNewGObject mkTextTag $ {# call unsafe text_tag_new #} nullPtr + wrapNewGObject mkTextTag $ {# call unsafe text_tag_new #} nullPtr -------------------- diff --git a/Graphics/UI/Gtk/Multiline/TextTagTable.chs b/Graphics/UI/Gtk/Multiline/TextTagTable.chs --- a/Graphics/UI/Gtk/Multiline/TextTagTable.chs +++ b/Graphics/UI/Gtk/Multiline/TextTagTable.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget TextTagTable -- @@ -58,7 +59,7 @@ import Control.Monad (liftM) import System.Glib.FFI -import System.Glib.GObject (constructNewGObject, makeNewGObject) +import System.Glib.GObject (wrapNewGObject, makeNewGObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} @@ -70,7 +71,7 @@ -- textTagTableNew :: IO TextTagTable textTagTableNew = - constructNewGObject mkTextTagTable $ + wrapNewGObject mkTextTagTable $ {# call unsafe text_tag_table_new #} -------------------- diff --git a/Graphics/UI/Gtk/Multiline/TextView.chs b/Graphics/UI/Gtk/Multiline/TextView.chs --- a/Graphics/UI/Gtk/Multiline/TextView.chs +++ b/Graphics/UI/Gtk/Multiline/TextView.chs @@ -143,6 +143,12 @@ textViewSetAcceptsTab, textViewGetAcceptsTab, #endif +#if GTK_CHECK_VERSION(2,22,0) + textViewGetHadjustment, + textViewGetVadjustment, + textViewImContextFilterKeypress, + textViewResetImContext, +#endif -- * Attributes textViewPixelsAboveLines, @@ -179,6 +185,7 @@ setTextViewScrollAdjustments, toggleCursorVisible, toggleOverwrite, + textViewPreeditChanged ) where import Control.Monad (liftM) @@ -187,7 +194,10 @@ import System.Glib.Attributes import System.Glib.Properties (newAttrFromStringProperty) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) -import System.Glib.GObject (constructNewGObject, makeNewGObject) +import System.Glib.GObject (wrapNewGObject, makeNewGObject) +import Graphics.UI.Gtk.Gdk.EventM (EventM, EKey) +import Control.Monad.Reader ( ask ) +import Control.Monad.Trans ( liftIO ) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {#import Graphics.UI.Gtk.Multiline.Types#} @@ -664,7 +674,7 @@ -- textChildAnchorNew :: IO TextChildAnchor textChildAnchorNew = - constructNewGObject mkTextChildAnchor + wrapNewGObject mkTextChildAnchor {# call unsafe text_child_anchor_new #} -- | Retrieve all 'Widget's at this @@ -1012,6 +1022,59 @@ (toTextView self) #endif +#if GTK_CHECK_VERSION(2,22,0) +-- | Gets the horizontal-scrolling 'Adjustment'. +-- +-- * Available since Gtk+ version 2.22 +-- +textViewGetHadjustment :: TextViewClass self => self -> IO Adjustment +textViewGetHadjustment self = + makeNewObject mkAdjustment $ + {#call gtk_text_view_get_hadjustment #} + (toTextView self) + +-- | Gets the vertical-scrolling 'Adjustment'. +-- +-- * Available since Gtk+ version 2.22 +-- +textViewGetVadjustment :: TextViewClass self => self -> IO Adjustment +textViewGetVadjustment self = + makeNewObject mkAdjustment $ + {#call gtk_text_view_get_vadjustment #} + (toTextView self) + +-- | Allow the 'TextView' input method to internally handle key press and release events. If this +-- function returns 'True', then no further processing should be done for this key event. See +-- 'imContextFilterKeypress'. +-- +-- Note that you are expected to call this function from your handler when overriding key event +-- handling. This is needed in the case when you need to insert your own key handling between the input +-- method and the default key event handling of the 'TextView'. +-- +-- * Available since Gtk+ version 2.22 +-- +textViewImContextFilterKeypress :: TextViewClass self => self -> EventM EKey Bool +textViewImContextFilterKeypress self = do + ptr <- ask + liftIO $ liftM toBool $ + {# call gtk_text_view_im_context_filter_keypress #} + (toTextView self) + (castPtr ptr) + +-- | Reset the input method context of the text view if needed. +-- +-- This can be necessary in the case where modifying the buffer would confuse on-going input method +-- behavior. +-- +-- * Available since Gtk+ version 2.22 +-- +textViewResetImContext :: TextViewClass self => self -> IO () +textViewResetImContext self = + {#call gtk_text_view_reset_im_context #} (toTextView self) + + +#endif + -------------------- -- Attributes @@ -1303,4 +1366,11 @@ -- toggleOverwrite :: TextViewClass self => Signal self (IO ()) toggleOverwrite = Signal (connect_NONE__NONE "toggle-overwrite") + +-- | If an input method is used, the typed text will not immediately be committed to the buffer. So if +-- you are interested in the text, connect to this signal. +-- +-- This signal is only emitted if the text at the given position is actually editable. +textViewPreeditChanged :: TextViewClass self => Signal self (String -> IO ()) +textViewPreeditChanged = Signal (connect_STRING__NONE "preedit-changed") diff --git a/Graphics/UI/Gtk/Ornaments/Frame.chs b/Graphics/UI/Gtk/Ornaments/Frame.chs --- a/Graphics/UI/Gtk/Ornaments/Frame.chs +++ b/Graphics/UI/Gtk/Ornaments/Frame.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Frame -- diff --git a/Graphics/UI/Gtk/Ornaments/HSeparator.chs b/Graphics/UI/Gtk/Ornaments/HSeparator.chs --- a/Graphics/UI/Gtk/Ornaments/HSeparator.chs +++ b/Graphics/UI/Gtk/Ornaments/HSeparator.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget HSeparator -- diff --git a/Graphics/UI/Gtk/Ornaments/VSeparator.chs b/Graphics/UI/Gtk/Ornaments/VSeparator.chs --- a/Graphics/UI/Gtk/Ornaments/VSeparator.chs +++ b/Graphics/UI/Gtk/Ornaments/VSeparator.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget VSeparator -- diff --git a/Graphics/UI/Gtk/Printing/PageSetup.chs b/Graphics/UI/Gtk/Printing/PageSetup.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Printing/PageSetup.chs @@ -0,0 +1,398 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget PageSetup +-- +-- Author : Andy Stewart +-- +-- Created: 28 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- Stores page setup information +-- +-- * Module available since Gtk+ version 2.10 +-- +module Graphics.UI.Gtk.Printing.PageSetup ( + +-- * Detail +-- +-- | A 'PageSetup' object stores the page size, orientation and margins. The +-- idea is that you can get one of these from the page setup dialog and then +-- pass it to the 'PrintOperation' when printing. The benefit of splitting this +-- out of the 'PrintSettings' is that these affect the actual layout of the +-- page, and thus need to be set long before user prints. +-- +-- The margins specified in this object are the \"print margins\", i.e. the +-- parts of the page that the printer cannot print on. These are different from +-- the layout margins that a word processor uses; they are typically used to +-- determine the /minimal/ size for the layout margins. +-- +-- To obtain a 'PageSetup' use 'pageSetupNew' to get the defaults, or use +-- 'printRunPageSetupDialog' to show the page setup dialog and receive the +-- resulting page setup. +-- +-- Printing support was added in Gtk+ 2.10. +-- + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----PageSetup +-- @ + +#if GTK_CHECK_VERSION(2,10,0) +-- * Types + PageSetup, + PageSetupClass, + castToPageSetup, + toPageSetup, + +-- * Constructors + pageSetupNew, +#if GTK_CHECK_VERSION(2,12,0) + pageSetupNewFromFile, +#endif + +-- * Methods + pageSetupCopy, + pageSetupGetTopMargin, + pageSetupSetTopMargin, + pageSetupGetBottomMargin, + pageSetupSetBottomMargin, + pageSetupGetLeftMargin, + pageSetupSetLeftMargin, + pageSetupGetRightMargin, + pageSetupSetRightMargin, + pageSetupSetPaperSizeAndDefaultMargins, + pageSetupGetPaperWidth, + pageSetupGetPaperHeight, + pageSetupGetPageWidth, + pageSetupGetPageHeight, +#if GTK_CHECK_VERSION(2,14,0) + pageSetupLoadFile, +#endif +#if GTK_CHECK_VERSION(2,12,0) + pageSetupToFile, +#endif + +-- * Attributes + pageSetupOrientation, + pageSetupPaperSize, +#endif + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.GError +import System.Glib.Attributes +import System.Glib.Properties +import System.Glib.UTFString +{#import Graphics.UI.Gtk.Types#} +{#import Graphics.UI.Gtk.Printing.PaperSize#} (PaperSize(..), mkPaperSize, Unit(..)) +{#import Graphics.UI.Gtk.Printing.PrintSettings#} (PageOrientation (..)) + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,10,0) +-------------------- +-- Constructors + +-- | Creates a new 'PageSetup'. +-- +pageSetupNew :: IO PageSetup +pageSetupNew = + wrapNewGObject mkPageSetup $ + {# call gtk_page_setup_new #} + +#if GTK_CHECK_VERSION(2,12,0) +-- | Reads the page setup from the file @fileName@. Returns a new 'PageSetup' +-- object with the restored page setup. +-- +-- * Available since Gtk+ version 2.12 +-- +pageSetupNewFromFile :: + String -- ^ @fileName@ - the filename to read the page setup from + -> IO PageSetup +pageSetupNewFromFile fileName = + propagateGError $ \errorPtr -> + withUTFString fileName $ \fileNamePtr -> do + setupPtr <- {# call gtk_page_setup_new_from_file #} + fileNamePtr + errorPtr + wrapNewGObject mkPageSetup (return setupPtr) + +#endif + +-------------------- +-- Methods + +-- | Copies a 'PageSetup'. +-- +pageSetupCopy :: PageSetupClass self => self + -> IO PageSetup -- ^ returns a copy of @other@ +pageSetupCopy self = + wrapNewGObject mkPageSetup $ + {# call gtk_page_setup_copy #} + (toPageSetup self) + +-- | Gets the page orientation of the 'PageSetup'. +pageSetupGetOrientation :: PageSetupClass self => self + -> IO PageOrientation -- ^ returns the page orientation +pageSetupGetOrientation self = + liftM (toEnum . fromIntegral) $ + {# call gtk_page_setup_get_orientation #} + (toPageSetup self) + +-- | Sets the page orientation of the 'PageSetup'. +pageSetupSetOrientation :: PageSetupClass self => self + -> PageOrientation -- ^ @orientation@ - a 'PageOrientation' value + -> IO () +pageSetupSetOrientation self orientation = + {# call gtk_page_setup_set_orientation #} + (toPageSetup self) + ((fromIntegral . fromEnum) orientation) + +-- | Gets the paper size of the 'PageSetup'. +pageSetupGetPaperSize :: PageSetupClass self => self + -> IO PaperSize -- ^ returns the paper size +pageSetupGetPaperSize self = + {# call gtk_page_setup_get_paper_size #} + (toPageSetup self) + >>= mkPaperSize . castPtr + +pageSetupSetPaperSize :: PageSetupClass self => self + -> PaperSize -- ^ @size@ - a 'PaperSize' + -> IO () +pageSetupSetPaperSize self size = + {# call gtk_page_setup_set_paper_size #} + (toPageSetup self) + size + +-- | Gets the top margin in units of @unit@. +-- +pageSetupGetTopMargin :: PageSetupClass self => self + -> Unit -- ^ @unit@ - the unit for the return value + -> IO Double -- ^ returns the top margin +pageSetupGetTopMargin self unit = + liftM realToFrac $ + {# call gtk_page_setup_get_top_margin #} + (toPageSetup self) + ((fromIntegral . fromEnum) unit) + +-- | Sets the top margin of the 'PageSetup'. +-- +pageSetupSetTopMargin :: PageSetupClass self => self + -> Double -- ^ @margin@ - the new top margin in units of @unit@ + -> Unit -- ^ @unit@ - the units for @margin@ + -> IO () +pageSetupSetTopMargin self margin unit = + {# call gtk_page_setup_set_top_margin #} + (toPageSetup self) + (realToFrac margin) + ((fromIntegral . fromEnum) unit) + +-- | Gets the bottom margin in units of @unit@. +-- +pageSetupGetBottomMargin :: PageSetupClass self => self + -> Unit -- ^ @unit@ - the unit for the return value + -> IO Double -- ^ returns the bottom margin +pageSetupGetBottomMargin self unit = + liftM realToFrac $ + {# call gtk_page_setup_get_bottom_margin #} + (toPageSetup self) + ((fromIntegral . fromEnum) unit) + +-- | Sets the bottom margin of the 'PageSetup'. +-- +pageSetupSetBottomMargin :: PageSetupClass self => self + -> Double -- ^ @margin@ - the new bottom margin in units of @unit@ + -> Unit -- ^ @unit@ - the units for @margin@ + -> IO () +pageSetupSetBottomMargin self margin unit = + {# call gtk_page_setup_set_bottom_margin #} + (toPageSetup self) + (realToFrac margin) + ((fromIntegral . fromEnum) unit) + +-- | Gets the left margin in units of @unit@. +-- +pageSetupGetLeftMargin :: PageSetupClass self => self + -> Unit -- ^ @unit@ - the unit for the return value + -> IO Double -- ^ returns the left margin +pageSetupGetLeftMargin self unit = + liftM realToFrac $ + {# call gtk_page_setup_get_left_margin #} + (toPageSetup self) + ((fromIntegral . fromEnum) unit) + +-- | Sets the left margin of the 'PageSetup'. +-- +pageSetupSetLeftMargin :: PageSetupClass self => self + -> Double -- ^ @margin@ - the new left margin in units of @unit@ + -> Unit -- ^ @unit@ - the units for @margin@ + -> IO () +pageSetupSetLeftMargin self margin unit = + {# call gtk_page_setup_set_left_margin #} + (toPageSetup self) + (realToFrac margin) + ((fromIntegral . fromEnum) unit) + +-- | Gets the right margin in units of @unit@. +-- +pageSetupGetRightMargin :: PageSetupClass self => self + -> Unit -- ^ @unit@ - the unit for the return value + -> IO Double -- ^ returns the right margin +pageSetupGetRightMargin self unit = + liftM realToFrac $ + {# call gtk_page_setup_get_right_margin #} + (toPageSetup self) + ((fromIntegral . fromEnum) unit) + +-- | Sets the right margin of the 'PageSetup'. +-- +pageSetupSetRightMargin :: PageSetupClass self => self + -> Double -- ^ @margin@ - the new right margin in units of @unit@ + -> Unit -- ^ @unit@ - the units for @margin@ + -> IO () +pageSetupSetRightMargin self margin unit = + {# call gtk_page_setup_set_right_margin #} + (toPageSetup self) + (realToFrac margin) + ((fromIntegral . fromEnum) unit) + +-- | Sets the paper size of the 'PageSetup' and modifies the margins according +-- to the new paper size. +-- +pageSetupSetPaperSizeAndDefaultMargins :: PageSetupClass self => self + -> PaperSize -- ^ @size@ - a 'PaperSize' + -> IO () +pageSetupSetPaperSizeAndDefaultMargins self size = + {# call gtk_page_setup_set_paper_size_and_default_margins #} + (toPageSetup self) + size + +-- | Returns the paper width in units of @unit@. +-- +-- Note that this function takes orientation, but not margins into +-- consideration. See 'pageSetupGetPageWidth'. +-- +pageSetupGetPaperWidth :: PageSetupClass self => self + -> Unit -- ^ @unit@ - the unit for the return value + -> IO Double -- ^ returns the paper width. +pageSetupGetPaperWidth self unit = + liftM realToFrac $ + {# call gtk_page_setup_get_paper_width #} + (toPageSetup self) + ((fromIntegral . fromEnum) unit) + +-- | Returns the paper height in units of @unit@. +-- +-- Note that this function takes orientation, but not margins into +-- consideration. See 'pageSetupGetPageHeight'. +-- +pageSetupGetPaperHeight :: PageSetupClass self => self + -> Unit -- ^ @unit@ - the unit for the return value + -> IO Double -- ^ returns the paper height. +pageSetupGetPaperHeight self unit = + liftM realToFrac $ + {# call gtk_page_setup_get_paper_height #} + (toPageSetup self) + ((fromIntegral . fromEnum) unit) + +-- | Returns the page width in units of @unit@. +-- +-- Note that this function takes orientation and margins into consideration. +-- See 'pageSetupGetPaperWidth'. +-- +pageSetupGetPageWidth :: PageSetupClass self => self + -> Unit -- ^ @unit@ - the unit for the return value + -> IO Double -- ^ returns the page width. +pageSetupGetPageWidth self unit = + liftM realToFrac $ + {# call gtk_page_setup_get_page_width #} + (toPageSetup self) + ((fromIntegral . fromEnum) unit) + +-- | Returns the page height in units of @unit@. +-- +-- Note that this function takes orientation and margins into consideration. +-- See 'pageSetupGetPaperHeight'. +-- +pageSetupGetPageHeight :: PageSetupClass self => self + -> Unit -- ^ @unit@ - the unit for the return value + -> IO Double -- ^ returns the page height. +pageSetupGetPageHeight self unit = + liftM realToFrac $ + {# call gtk_page_setup_get_page_height #} + (toPageSetup self) + ((fromIntegral . fromEnum) unit) + +#if GTK_CHECK_VERSION(2,14,0) +-- | Reads the page setup from the file @fileName@. See 'pageSetupToFile'. +-- +-- * Available since Gtk+ version 2.14 +-- +pageSetupLoadFile :: PageSetupClass self => self + -> String -- ^ @fileName@ - the filename to read the page setup from + -> IO Bool -- ^ returns @True@ on success +pageSetupLoadFile self fileName = + liftM toBool $ + propagateGError $ \errorPtr -> + withUTFString fileName $ \fileNamePtr -> + {# call gtk_page_setup_load_file #} + (toPageSetup self) + fileNamePtr + errorPtr + +#endif + +#if GTK_CHECK_VERSION(2,12,0) +-- | This function saves the information from @setup@ to @fileName@. +-- +-- * Available since Gtk+ version 2.12 +-- +pageSetupToFile :: PageSetupClass self => self + -> String -- ^ @fileName@ - the file to save to + -> IO Bool -- ^ returns @True@ on success +pageSetupToFile self fileName = + liftM toBool $ + propagateGError $ \errorPtr -> + withUTFString fileName $ \fileNamePtr -> + {# call gtk_page_setup_to_file #} + (toPageSetup self) + fileNamePtr + errorPtr + +#endif +-- | The page orientation of the 'PageSetup'. +pageSetupOrientation :: PageSetupClass self => Attr self PageOrientation +pageSetupOrientation = newAttr + pageSetupGetOrientation + pageSetupSetOrientation + +-- | The paper size of the 'PageSetup'. +pageSetupPaperSize :: PageSetupClass self => Attr self PaperSize +pageSetupPaperSize = newAttr + pageSetupGetPaperSize + pageSetupSetPaperSize + +#endif + diff --git a/Graphics/UI/Gtk/Printing/PaperSize.chs b/Graphics/UI/Gtk/Printing/PaperSize.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Printing/PaperSize.chs @@ -0,0 +1,362 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget PaperSize +-- +-- Author : Andy Stewart +-- +-- Created: 28 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- Support for named paper sizes +-- +module Graphics.UI.Gtk.Printing.PaperSize ( + +-- * Detail +-- +-- | 'PaperSize' handles paper sizes. It uses the +-- standard called \"PWG 5101.1-2002 PWG: Standard for Media Standardized +-- Names\" to name the paper sizes (and to get the data for the page sizes). In +-- addition to standard paper sizes, 'PaperSize' allows +-- to construct custom paper sizes with arbitrary dimensions. +-- +-- The 'PaperSize' object stores not only the +-- dimensions (width and height) of a paper size and its name, it also provides +-- default print margins. +-- +-- Printing support has been added in Gtk+ 2.10. + +#if GTK_CHECK_VERSION(2,10,0) +-- * Types + PaperSize(..), + mkPaperSize, + +-- * Enums + Unit(..), + +-- * Constructors + paperSizeNew, + paperSizeNewFromPpd, + paperSizeNewCustom, + +-- * Methods + paperSizeCopy, + paperSizeIsEqual, + paperSizeGetName, + paperSizeGetDisplayName, + paperSizeGetPpdName, + paperSizeGetWidth, + paperSizeGetHeight, + paperSizeIsCustom, + paperSizeSetSize, + paperSizeGetDefaultTopMargin, + paperSizeGetDefaultBottomMargin, + paperSizeGetDefaultLeftMargin, + paperSizeGetDefaultRightMargin, + paperSizeGetDefault, +#endif +#if GTK_CHECK_VERSION(2,12,0) + paperSizeGetPaperSizes, +#endif + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.UTFString +import System.Glib.GList +{#import Graphics.UI.Gtk.Types#} + +{# context lib="gtk" prefix="gtk" #} + +-------------------- +-- Types +{#pointer *PaperSize foreign newtype#} + +-------------------- +-- Enums +{#enum Unit {underscoreToCase} deriving (Bounded,Eq,Show)#} + +-------------------- +-- Constructors + +mkPaperSize :: Ptr PaperSize -> IO PaperSize +mkPaperSize pPtr = do + size <- newForeignPtr pPtr paper_size_free + return (PaperSize size) + +foreign import ccall unsafe ">k_paper_size_free" + paper_size_free :: FinalizerPtr PaperSize + +#if GTK_CHECK_VERSION(2,10,0) +-- | Creates a new 'PaperSize' object by parsing a PWG +-- 5101.1-2002 paper name. +-- +-- If @name@ is Nothing, the default paper size is returned, see 'paperSizeGetDefault'. +-- +-- * Available since Gtk+ version 2.10 +-- +paperSizeNew :: + Maybe String -- ^ @name@ - a paper size name, or 'Nothing' + -> IO PaperSize +paperSizeNew name = + maybeWith withUTFString name $ \namePtr -> + {# call gtk_paper_size_new #} + namePtr + >>= mkPaperSize + +-- | Creates a new 'PaperSize' object by using PPD +-- information. +-- +-- If @ppdName@ is not a recognized PPD paper name, @ppdDisplayName@, +-- @width@ and @height@ are used to construct a custom 'PaperSize' object. +-- +-- * Available since Gtk+ version 2.10 +-- +paperSizeNewFromPpd :: + String -- ^ @ppdName@ - a PPD paper name + -> String -- ^ @ppdDisplayName@ - the corresponding human-readable name + -> Double -- ^ @width@ - the paper width, in points + -> Double -- ^ @height@ - the paper height in points + -> IO PaperSize +paperSizeNewFromPpd ppdName ppdDisplayName width height = + withUTFString ppdDisplayName $ \ppdDisplayNamePtr -> + withUTFString ppdName $ \ppdNamePtr -> + {# call gtk_paper_size_new_from_ppd #} + ppdNamePtr + ppdDisplayNamePtr + (realToFrac width) + (realToFrac height) + >>= mkPaperSize + +-- | Creates a new 'PaperSize' object with the given +-- parameters. +-- +-- * Available since Gtk+ version 2.10 +-- +paperSizeNewCustom :: + String -- ^ @name@ - the paper name + -> String -- ^ @displayName@ - the human-readable name + -> Double -- ^ @width@ - the paper width, in units of @unit@ + -> Double -- ^ @height@ - the paper height, in units of @unit@ + -> Unit -- ^ @unit@ - the unit for @width@ and @height@ + -> IO PaperSize +paperSizeNewCustom name displayName width height unit = + withUTFString displayName $ \displayNamePtr -> + withUTFString name $ \namePtr -> + {# call gtk_paper_size_new_custom #} + namePtr + displayNamePtr + (realToFrac width) + (realToFrac height) + ((fromIntegral . fromEnum) unit) + >>= mkPaperSize + + +-------------------- +-- Methods + +-- | Copies an existing 'PaperSize'. +-- +-- * Available since Gtk+ version 2.10 +-- +paperSizeCopy :: PaperSize + -> IO PaperSize -- ^ returns a copy of @other@ +paperSizeCopy self = + {# call gtk_paper_size_copy #} self >>= mkPaperSize + +-- | Compares two 'PaperSize' objects. +-- +-- * Available since Gtk+ version 2.10 +-- +paperSizeIsEqual :: PaperSize + -> PaperSize -- ^ @size2@ - another 'PaperSize' object + -> IO Bool -- ^ returns @True@, if @size1@ and @size2@ represent + -- the same paper size +paperSizeIsEqual self size2 = + liftM toBool $ + {# call gtk_paper_size_is_equal #} + self + size2 + +-- | Gets the name of the 'PaperSize'. +-- +-- * Available since Gtk+ version 2.10 +-- +paperSizeGetName :: PaperSize + -> IO String -- ^ returns the name of @size@ +paperSizeGetName self = + {# call gtk_paper_size_get_name #} + self + >>= peekUTFString + +-- | Gets the human-readable name of the 'PaperSize'. +-- +-- * Available since Gtk+ version 2.10 +-- +paperSizeGetDisplayName :: PaperSize + -> IO String -- ^ returns the human-readable name of @size@ +paperSizeGetDisplayName self = + {# call gtk_paper_size_get_display_name #} + self + >>= peekUTFString + +-- | Gets the PPD name of the 'PaperSize', which may be +-- +-- * Available since Gtk+ version 2.10 +-- +paperSizeGetPpdName :: PaperSize + -> IO (Maybe String) -- ^ returns the PPD name of @size@, or 'Nothing' +paperSizeGetPpdName self = + {# call gtk_paper_size_get_ppd_name #} + self + >>= maybePeekUTFString + +-- | Gets the paper width of the 'PaperSize', in units +-- of @unit@. +-- +-- * Available since Gtk+ version 2.10 +-- +paperSizeGetWidth :: PaperSize + -> Unit -- ^ @unit@ - the unit for the return value + -> IO Double -- ^ returns the paper width +paperSizeGetWidth self unit = + liftM realToFrac $ + {# call gtk_paper_size_get_width #} + self + ((fromIntegral . fromEnum) unit) + +-- | Gets the paper height of the 'PaperSize', in units +-- of @unit@. +-- +-- * Available since Gtk+ version 2.10 +-- +paperSizeGetHeight :: PaperSize + -> Unit -- ^ @unit@ - the unit for the return value + -> IO Double -- ^ returns the paper height +paperSizeGetHeight self unit = + liftM realToFrac $ + {# call gtk_paper_size_get_height #} + self + ((fromIntegral . fromEnum) unit) + +-- | Returns @True@ if @size@ is not a standard paper size. +-- +paperSizeIsCustom :: PaperSize + -> IO Bool -- ^ returns whether @size@ is a custom paper size. +paperSizeIsCustom self = + liftM toBool $ + {# call gtk_paper_size_is_custom #} + self + +-- | Changes the dimensions of a @size@ to @width@ x @height@. +-- +-- * Available since Gtk+ version 2.10 +-- +paperSizeSetSize :: PaperSize + -> Double -- ^ @width@ - the new width in units of @unit@ + -> Double -- ^ @height@ - the new height in units of @unit@ + -> Unit -- ^ @unit@ - the unit for @width@ and @height@ + -> IO () +paperSizeSetSize self width height unit = + {# call gtk_paper_size_set_size #} + self + (realToFrac width) + (realToFrac height) + ((fromIntegral . fromEnum) unit) + +-- | Gets the default top margin for the 'PaperSize'. +-- +-- * Available since Gtk+ version 2.10 +-- +paperSizeGetDefaultTopMargin :: PaperSize + -> Unit -- ^ @unit@ - the unit for the return value + -> IO Double -- ^ returns the default top margin +paperSizeGetDefaultTopMargin self unit = + liftM realToFrac $ + {# call gtk_paper_size_get_default_top_margin #} + self + ((fromIntegral . fromEnum) unit) + +-- | Gets the default bottom margin for the 'PaperSize'. +-- +-- * Available since Gtk+ version 2.10 +-- +paperSizeGetDefaultBottomMargin :: PaperSize + -> Unit -- ^ @unit@ - the unit for the return value + -> IO Double -- ^ returns the default bottom margin +paperSizeGetDefaultBottomMargin self unit = + liftM realToFrac $ + {# call gtk_paper_size_get_default_bottom_margin #} + self + ((fromIntegral . fromEnum) unit) + +-- | Gets the default left margin for the 'PaperSize'. +-- +-- * Available since Gtk+ version 2.10 +-- +paperSizeGetDefaultLeftMargin :: PaperSize + -> Unit -- ^ @unit@ - the unit for the return value + -> IO Double -- ^ returns the default left margin +paperSizeGetDefaultLeftMargin self unit = + liftM realToFrac $ + {# call gtk_paper_size_get_default_left_margin #} + self + ((fromIntegral . fromEnum) unit) + +-- | Gets the default right margin for the 'PaperSize'. +-- +-- * Available since Gtk+ version 2.10 +-- +paperSizeGetDefaultRightMargin :: PaperSize + -> Unit -- ^ @unit@ - the unit for the return value + -> IO Double -- ^ returns the default right margin +paperSizeGetDefaultRightMargin self unit = + liftM realToFrac $ + {# call gtk_paper_size_get_default_right_margin #} + self + ((fromIntegral . fromEnum) unit) + +-- | Returns the name of the default paper size, which depends on the current +-- locale. +-- +-- * Available since Gtk+ version 2.10 +-- +paperSizeGetDefault :: + IO String -- ^ returns the name of the default paper size. +paperSizeGetDefault = + {# call gtk_paper_size_get_default #} + >>= peekUTFString + +#endif + +#if GTK_CHECK_VERSION(2,12,0) +-- | Creates a list of known paper sizes. +-- +-- * Available since Gtk+ version 2.12 +-- +paperSizeGetPaperSizes :: + Bool -- ^ @includeCustom@ - whether to include custom + -- paper sizes as defined in the page setup dialog + -> IO [PaperSize] +paperSizeGetPaperSizes includeCustom = do + glist <- {# call gtk_paper_size_get_paper_sizes #} (fromBool includeCustom) + list <- fromGList glist + mapM mkPaperSize list +#endif + diff --git a/Graphics/UI/Gtk/Printing/PrintContext.chs b/Graphics/UI/Gtk/Printing/PrintContext.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Printing/PrintContext.chs @@ -0,0 +1,225 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget PrintContext +-- +-- Author : Andy Stewart +-- +-- Created: 28 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- Encapsulates context for drawing pages +-- +-- * Module available since Gtk+ version 2.10 +-- +module Graphics.UI.Gtk.Printing.PrintContext ( + +-- * Detail +-- +-- | A 'PrintContext' encapsulates context information that is required when +-- drawing pages for printing, such as the cairo context and important +-- parameters like page size and resolution. It also lets you easily create +-- 'PangoLayout' and 'Context' objects that match the font metrics of the cairo +-- surface. +-- +-- 'PrintContext' objects gets passed to the 'beginPrint', 'endPrint', +-- 'requestPageSetup' and 'drawPage' signals on the 'PrintOperation'. +-- +-- Printing support was added in Gtk+ 2.10. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----PrintContext +-- @ + +#if GTK_CHECK_VERSION(2,10,0) +-- * Types + PrintContext, + PrintContextClass, + castToPrintContext, + toPrintContext, + +-- * Methods + printContextGetCairoContext, + printContextSetCairoContext, + printContextGetPageSetup, + printContextGetWidth, + printContextGetHeight, + printContextGetDpiX, + printContextGetDpiY, + printContextGetPangoFontmap, + printContextCreatePangoContext, + printContextCreatePangoLayout, +#if GTK_CHECK_VERSION(2,20,0) + printContextGetHardMargins, +#endif +#endif + ) where + +import Control.Monad (liftM) +import Data.IORef (newIORef) + +import System.Glib.FFI +{#import Graphics.UI.Gtk.Types#} +{#import Graphics.Rendering.Pango.Types#} +{#import Graphics.Rendering.Pango.BasicTypes#} +{#import Graphics.Rendering.Cairo.Types#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,10,0) +-------------------- +-- Methods + +-- | Obtains the cairo context that is associated with the 'PrintContext'. +-- +printContextGetCairoContext :: PrintContextClass self => self + -> IO Cairo -- ^ returns the cairo context of @context@ +printContextGetCairoContext self = + liftM Cairo $ + {# call gtk_print_context_get_cairo_context #} (toPrintContext self) + +-- | Sets a new cairo context on a print context. +-- +-- This function is intended to be used when implementing an internal print +-- preview, it is not needed for printing, since Gtk+ itself creates a suitable +-- cairo context in that case. +-- +printContextSetCairoContext :: PrintContextClass self => self + -> Cairo -- ^ @cr@ - the cairo context + -> Double -- ^ @dpiX@ - the horizontal resolution to use with @cr@ + -> Double -- ^ @dpiY@ - the vertical resolution to use with @cr@ + -> IO () +printContextSetCairoContext self cr dpiX dpiY = + {# call gtk_print_context_set_cairo_context #} + (toPrintContext self) + cr + (realToFrac dpiX) + (realToFrac dpiY) + +-- | Obtains the 'PageSetup' that determines the page dimensions of the +-- 'PrintContext'. +-- +printContextGetPageSetup :: PrintContextClass self => self + -> IO PageSetup -- ^ returns the page setup of @context@ +printContextGetPageSetup self = + makeNewGObject mkPageSetup $ + {# call gtk_print_context_get_page_setup #} + (toPrintContext self) + +-- | Obtains the width of the 'PrintContext', in pixels. +-- +printContextGetWidth :: PrintContextClass self => self + -> IO Double -- ^ returns the width of @context@ +printContextGetWidth self = + liftM realToFrac $ + {# call gtk_print_context_get_width #} + (toPrintContext self) + +-- | Obtains the height of the 'PrintContext', in pixels. +-- +printContextGetHeight :: PrintContextClass self => self + -> IO Double -- ^ returns the height of @context@ +printContextGetHeight self = + liftM realToFrac $ + {# call gtk_print_context_get_height #} + (toPrintContext self) + +-- | Obtains the horizontal resolution of the 'PrintContext', in dots per +-- inch. +-- +printContextGetDpiX :: PrintContextClass self => self + -> IO Double -- ^ returns the horizontal resolution of @context@ +printContextGetDpiX self = + liftM realToFrac $ + {# call gtk_print_context_get_dpi_x #} + (toPrintContext self) + +-- | Obtains the vertical resolution of the 'PrintContext', in dots per inch. +-- +printContextGetDpiY :: PrintContextClass self => self + -> IO Double -- ^ returns the vertical resolution of @context@ +printContextGetDpiY self = + liftM realToFrac $ + {# call gtk_print_context_get_dpi_y #} + (toPrintContext self) + +-- | Returns a 'FontMap' that is suitable for use with the 'PrintContext'. +-- +printContextGetPangoFontmap :: PrintContextClass self => self + -> IO FontMap -- ^ returns the font map of @context@ +printContextGetPangoFontmap self = + makeNewGObject mkFontMap $ + {# call gtk_print_context_get_pango_fontmap #} + (toPrintContext self) + +-- | Creates a new 'Context' that can be used with the 'PrintContext'. +-- +printContextCreatePangoContext :: PrintContextClass self => self + -> IO PangoContext -- ^ returns a new Pango context for @context@ +printContextCreatePangoContext self = + wrapNewGObject mkPangoContext $ + {# call gtk_print_context_create_pango_context #} + (toPrintContext self) + +-- | Creates a new 'PangoLayout' that is suitable for use with the +-- 'PrintContext'. +-- +printContextCreatePangoLayout :: PrintContextClass self => self + -> IO PangoLayout -- ^ returns a new Pango layout for @context@ +printContextCreatePangoLayout self = do + pl <- wrapNewGObject mkPangoLayoutRaw $ + {# call gtk_print_context_create_pango_layout #} + (toPrintContext self) + ps <- makeNewPangoString "" + psRef <- newIORef ps + return (PangoLayout psRef pl) + +#if GTK_CHECK_VERSION(2,20,0) +printContextGetHardMargins :: PrintContextClass self => self + -> IO (Maybe (Double, Double, Double, Double)) + -- ^ returns @(top, bottom, left, right)@ + -- @top@ top hardware printer margin + -- @bottom@ bottom hardware printer margin + -- @left@ left hardware printer margin + -- @right@ right hardware printer margin +printContextGetHardMargins self = + alloca $ \ topPtr -> + alloca $ \ bottomPtr -> + alloca $ \ leftPtr -> + alloca $ \ rightPtr -> do + success <- liftM toBool $ {#call gtk_print_context_get_hard_margins #} + (toPrintContext self) + topPtr + bottomPtr + leftPtr + rightPtr + if success + then do + top <- liftM realToFrac $ peek topPtr + bottom <- liftM realToFrac $ peek bottomPtr + left <- liftM realToFrac $ peek leftPtr + right <- liftM realToFrac $ peek rightPtr + return $ Just (top, bottom, left, right) + else return Nothing +#endif + +#endif diff --git a/Graphics/UI/Gtk/Printing/PrintOperation.chs b/Graphics/UI/Gtk/Printing/PrintOperation.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Printing/PrintOperation.chs @@ -0,0 +1,935 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget PrintOperation +-- +-- Author : Andy Stewart +-- +-- Created: 28 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- High-level Printing API +-- +-- * Module available since Gtk+ version 2.10 +-- +module Graphics.UI.Gtk.Printing.PrintOperation ( + +-- * Detail +-- +-- | 'PrintOperation' is the high-level, portable printing API. It looks a bit +-- different than other Gtk+ dialogs such as the 'FileChooser', since some +-- platforms don't expose enough infrastructure to implement a good print +-- dialog. On such platforms, 'PrintOperation' uses the native print dialog. On +-- platforms which do not provide a native print dialog, Gtk+ uses its own, see +-- 'PrintUnixDialog'. +-- +-- The typical way to use the high-level printing API is to create a +-- 'PrintOperation' object with 'printOperationNew' when the user selects to +-- print. Then you set some properties on it, e.g. the page size, any +-- 'PrintSettings' from previous print operations, the number of pages, the +-- current page, etc. +-- +-- Then you start the print operation by calling 'printOperationRun'. It +-- will then show a dialog, let the user select a printer and options. When the +-- user finished the dialog various signals will be emitted on the +-- 'PrintOperation', the main one being 'draw-page' signal, which you are supposed to +-- catch and render the page on the provided 'PrintContext' using Cairo. +-- +-- By default 'PrintOperation' uses an external application to do print +-- preview. To implement a custom print preview, an application must connect to +-- the preview signal. The functions 'printOperationPrintPreviewRenderPage', +-- 'printOperationPreviewEndPreview' and 'printOperationPreviewIsSelected' are +-- useful when implementing a print preview. +-- +-- Printing support was added in Gtk+ 2.10. +-- + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----PrintOperation +-- @ + +#if GTK_CHECK_VERSION(2,10,0) +-- * Types + PrintOperation, + PrintOperationClass, + castToPrintOperation, + toPrintOperation, + + PrintOperationPreview, + PrintOperationPreviewClass, + castToPrintOperationPreview, + toPrintOperationPreview, + +-- * Enums + PrintStatus(..), + PrintOperationAction(..), + PrintOperationResult(..), + PrintError(..), + +-- * Constructors + printOperationNew, + +-- * Methods + printOperationSetAllowAsync, + printOperationGetError, +#if GTK_CHECK_VERSION(2,18,0) + printOperationGetNPagesToPrint, +#endif + printOperationRun, + printOperationCancel, +#if GTK_CHECK_VERSION(2,16,0) + printOperationDrawPageFinish, + printOperationSetDeferDrawing, +#endif + printOperationGetStatus, + printOperationGetStatusString, + printOperationIsFinished, + printRunPageSetupDialog, + printRunPageSetupDialogAsync, + + printOperationPreviewEndPreview, + printOperationPreviewIsSelected, + printOperationPreviewRenderPage, + +-- * Attributes + printOperationDefaultPageSetup, + printOperationPrintSettings, + printOperationJobName, + printOperationNPages, + printOperationCurrentPage, + printOperationUseFullPage, + printOperationTrackPrintStatus, + printOperationUnit, + printOperationShowProgress, + printOperationAllowAsync, + printOperationExportFilename, + printOperationStatus, + printOperationStatusString, + printOperationCustomTabLabel, +#if GTK_CHECK_VERSION(2,18,0) + printOperationSupportSelection, + printOperationHasSelection, + printOperationEmbedPageSetup, + printOperationNPagesToPrint, +#endif + +-- * Signals + printOptDone, + printOptBeginPrint, + printOptPaginate, + printOptRequestPageSetup, + printOptDrawPage, + printOptEndPrint, + printOptStatusChanged, + printOptCreateCustomWidget, +#if GTK_CHECK_VERSION(2,18,0) + printOptUpdateCustomWidget, +#endif + printOptCustomWidgetApply, + printOptPreview, + printOptReady, + printOptGotPageSize, +#endif + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.Attributes +import System.Glib.Properties +import System.Glib.UTFString +import System.Glib.GError +{#import Graphics.UI.Gtk.Types#} +{#import Graphics.UI.Gtk.Signals#} +import Graphics.UI.Gtk.Printing.PaperSize (Unit(..)) + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,10,0) +-------------------- +-- Interfaces + +instance PrintOperationPreviewClass PrintOperation + +-------------------- +-- Enums +-- | The status gives a rough indication of the completion of a running print operation. +{#enum PrintStatus {underscoreToCase} deriving (Bounded,Eq,Show)#} + +-- | The action parameter to 'printOperationRun' determines what action the print operation should +-- perform. +{#enum PrintOperationAction {underscoreToCase} deriving (Bounded,Eq,Show)#} + +-- | A value of this type is returned by 'printOperationRun'. +{#enum PrintOperationResult {underscoreToCase} deriving (Bounded,Eq,Show)#} + +-- | Error codes that identify various errors that can occur while using the GTK+ printing support. +{#enum PrintError {underscoreToCase} deriving (Bounded,Eq,Show)#} + +-------------------- +-- Constructors + +-- | Creates a new 'PrintOperation'. +-- +printOperationNew :: IO PrintOperation +printOperationNew = + wrapNewGObject mkPrintOperation $ + {# call gtk_print_operation_new #} + +-------------------- +-- Methods + +-- | Sets whether the 'printOperationRun' may return before the print +-- operation is completed. Note that some platforms may not allow asynchronous +-- operation. +-- +printOperationSetAllowAsync :: PrintOperationClass self => self + -> Bool -- ^ @allowAsync@ - @True@ to allow asynchronous operation + -> IO () +printOperationSetAllowAsync self allowAsync = + {# call gtk_print_operation_set_allow_async #} + (toPrintOperation self) + (fromBool allowAsync) + +-- | Call this when the result of a print operation is +-- 'PrintOperationResultError', either as returned by 'printOperationRun', or +-- in the 'done' signal handler. The returned +-- 'GError' will contain more details on what went wrong. +-- +printOperationGetError :: PrintOperationClass self => self -> IO () +printOperationGetError self = + propagateGError $ \errorPtr -> + {# call gtk_print_operation_get_error #} + (toPrintOperation self) + errorPtr + +-- | Sets the name of the print job. The name is used to identify the job +-- (e.g. in monitoring applications like eggcups). +-- +-- If you don't set a job name, Gtk+ picks a default one by numbering +-- successive print jobs. +-- +printOperationSetJobName :: PrintOperationClass self => self + -> String -- ^ @jobName@ - a string that identifies the print job + -> IO () +printOperationSetJobName self jobName = + withUTFString jobName $ \jobNamePtr -> + {# call gtk_print_operation_set_job_name #} + (toPrintOperation self) + jobNamePtr + +-- | Sets the number of pages in the document. +-- +-- This /must/ be set to a positive number before the rendering starts. It +-- may be set in a 'beginPrint' signal hander. +-- +-- Note that the page numbers passed to the 'requestPageSetup' +-- and 'drawPage' signals +-- are 0-based, i.e. if the user chooses to print all pages, the last +-- 'draw-page' signal will be for page @nPages@ - 1. +-- +printOperationSetNPages :: PrintOperationClass self => self + -> Int -- ^ @nPages@ - the number of pages + -> IO () +printOperationSetNPages self nPages = + {# call gtk_print_operation_set_n_pages #} + (toPrintOperation self) + (fromIntegral nPages) + +#if GTK_CHECK_VERSION(2,18,0) +-- | Returns the number of pages that will be printed. +-- +-- Note that this value is set during print preparation phase +-- ('PrintStatusPreparing'), so this function should never be called before the +-- data generation phase ('PrintStatusGeneratingData'). You can connect to the +-- 'statusChanged' signal and call +-- 'printOperationGetNPagesToPrint' when print status is +-- 'PrintStatusGeneratingData'. This is typically used to track the progress of +-- print operation. +-- +-- * Available since Gtk+ version 2.18 +-- +printOperationGetNPagesToPrint :: PrintOperationClass self => self + -> IO Int -- ^ returns the number of pages that will be printed +printOperationGetNPagesToPrint self = + liftM fromIntegral $ + {# call gtk_print_operation_get_n_pages_to_print #} + (toPrintOperation self) +#endif + +-- | Sets the current page. +-- +-- If this is called before 'printOperationRun', the user will be able to +-- select to print only the current page. +-- +-- Note that this only makes sense for pre-paginated documents. +-- +printOperationSetCurrentPage :: PrintOperationClass self => self + -> Int -- ^ @currentPage@ - the current page, 0-based + -> IO () +printOperationSetCurrentPage self currentPage = + {# call gtk_print_operation_set_current_page #} + (toPrintOperation self) + (fromIntegral currentPage) + +-- | If @fullPage@ is @True@, the transformation for the cairo context +-- obtained from 'PrintContext' puts the origin at the top left corner of the +-- page (which may not be the top left corner of the sheet, depending on page +-- orientation and the number of pages per sheet). Otherwise, the origin is at +-- the top left corner of the imageable area (i.e. inside the margins). +-- +printOperationSetUseFullPage :: PrintOperationClass self => self + -> Bool -- ^ @fullPage@ - @True@ to set up the 'PrintContext' for the full + -- page + -> IO () +printOperationSetUseFullPage self fullPage = + {# call gtk_print_operation_set_use_full_page #} + (toPrintOperation self) + (fromBool fullPage) + +-- | Sets up the transformation for the cairo context obtained from +-- 'PrintContext' in such a way that distances are measured in units of @unit@. +-- +printOperationSetUnit :: PrintOperationClass self => self + -> Unit -- ^ @unit@ - the unit to use + -> IO () +printOperationSetUnit self unit = + {# call gtk_print_operation_set_unit #} + (toPrintOperation self) + ((fromIntegral . fromEnum) unit) + +-- | Sets up the 'PrintOperation' to generate a file instead of showing the +-- print dialog. The indended use of this function is for implementing \"Export +-- to PDF\" actions. Currently, PDF is the only supported format. +-- +-- \"Print to PDF\" support is independent of this and is done by letting +-- the user pick the \"Print to PDF\" item from the list of printers in the +-- print dialog. +-- +printOperationSetExportFilename :: PrintOperationClass self => self + -> String -- ^ @filename@ - the filename for the exported file + -> IO () +printOperationSetExportFilename self filename = + withUTFString filename $ \filenamePtr -> + {# call gtk_print_operation_set_export_filename #} + (toPrintOperation self) + filenamePtr + +-- | If @showProgress@ is @True@, the print operation will show a progress +-- dialog during the print operation. +-- +printOperationSetShowProgress :: PrintOperationClass self => self + -> Bool -- ^ @showProgress@ - @True@ to show a progress dialog + -> IO () +printOperationSetShowProgress self showProgress = + {# call gtk_print_operation_set_show_progress #} + (toPrintOperation self) + (fromBool showProgress) + +-- | If track_status is @True@, the print operation will try to continue +-- report on the status of the print job in the printer queues and printer. +-- This can allow your application to show things like \"out of paper\" issues, +-- and when the print job actually reaches the printer. +-- +-- This function is often implemented using some form of polling, so it +-- should not be enabled unless needed. +-- +printOperationSetTrackPrintStatus :: PrintOperationClass self => self + -> Bool -- ^ @trackStatus@ - @True@ to track status after printing + -> IO () +printOperationSetTrackPrintStatus self trackStatus = + {# call gtk_print_operation_set_track_print_status #} + (toPrintOperation self) + (fromBool trackStatus) + +-- | Sets the label for the tab holding custom widgets. +-- +printOperationSetCustomTabLabel :: PrintOperationClass self => self + -> String -- ^ @label@ - the label to use, or empty to use the default + -- label + -> IO () +printOperationSetCustomTabLabel self label = + withUTFString label $ \labelPtr -> + {# call gtk_print_operation_set_custom_tab_label #} + (toPrintOperation self) + labelPtr + +-- | Runs the print operation, by first letting the user modify print settings +-- in the print dialog, and then print the document. +-- +-- Normally that this function does not return until the rendering of all +-- pages is complete. You can connect to the 'statusChanged' signal on @op@ to obtain some information about the +-- progress of the print operation. Furthermore, it may use a recursive +-- mainloop to show the print dialog. +-- +-- If you call 'printOperationSetAllowAsync' or set the 'allowAsync' +-- property the operation will run asynchronously +-- if this is supported on the platform. The 'done' signal will be emitted with the result of the operation when +-- the it is done (i.e. when the dialog is canceled, or when the print succeeds +-- or fails). +-- +printOperationRun :: (PrintOperationClass self, WindowClass parent) => self + -> PrintOperationAction -- ^ @action@ - the action to start + -> parent -- ^ @parent@ - Transient parent of the dialog + -> IO PrintOperationResult -- ^ returns the result of the print operation. A + -- return value of 'PrintOperationResultApply' + -- indicates that the printing was completed + -- successfully. In this case, it is a good idea to + -- obtain the used print settings with + -- 'printOperationGetPrintSettings' and store them + -- for reuse with the next print operation. A value + -- of 'PrintOperationResultInProgress' means the + -- operation is running asynchronously, and will + -- emit the 'done' signal when done. +printOperationRun self action parent = + liftM (toEnum . fromIntegral) $ + propagateGError $ \errorPtr -> + {# call gtk_print_operation_run #} + (toPrintOperation self) + ((fromIntegral . fromEnum) action) + (toWindow parent) + errorPtr + +-- | Cancels a running print operation. This function may be called from a +-- 'beginPrint', 'paginate' or 'drawPage' signal handler +-- to stop the currently running print operation. +-- +printOperationCancel :: PrintOperationClass self => self -> IO () +printOperationCancel self = + {# call gtk_print_operation_cancel #} + (toPrintOperation self) + +#if GTK_CHECK_VERSION(2,16,0) +-- | Signalize that drawing of particular page is complete. +-- +-- It is called after completion of page drawing (e.g. drawing in another +-- thread). If 'printOperationSetDeferDrawing' was called before, then this +-- function has to be called by application. In another case it is called by +-- the library itself. +-- +-- * Available since Gtk+ version 2.16 +-- +printOperationDrawPageFinish :: PrintOperationClass self => self -> IO () +printOperationDrawPageFinish self = + {# call gtk_print_operation_draw_page_finish #} + (toPrintOperation self) + +-- | Sets up the 'PrintOperation' to wait for calling of +-- 'printOperationDrawPageFinish' from application. It can be used for drawing +-- page in another thread. +-- +-- This function must be called in the callback of \"draw-page\" signal. +-- +-- * Available since Gtk+ version 2.16 +-- +printOperationSetDeferDrawing :: PrintOperationClass self => self -> IO () +printOperationSetDeferDrawing self = + {# call gtk_print_operation_set_defer_drawing #} + (toPrintOperation self) +#endif + +-- | Returns the status of the print operation. Also see +-- 'printOperationGetStatusString'. +-- +printOperationGetStatus :: PrintOperationClass self => self + -> IO PrintStatus -- ^ returns the status of the print operation +printOperationGetStatus self = + liftM (toEnum . fromIntegral) $ + {# call gtk_print_operation_get_status #} + (toPrintOperation self) + +-- | Returns a string representation of the status of the print operation. The +-- string is translated and suitable for displaying the print status e.g. in a +-- 'Statusbar'. +-- +-- Use 'printOperationGetStatus' to obtain a status value that is suitable +-- for programmatic use. +-- +printOperationGetStatusString :: PrintOperationClass self => self + -> IO String -- ^ returns a string representation of the status of the print + -- operation +printOperationGetStatusString self = + {# call gtk_print_operation_get_status_string #} + (toPrintOperation self) + >>= peekUTFString + +-- | A convenience function to find out if the print operation is finished, +-- either successfully ('PrintStatusFinished') or unsuccessfully +-- ('PrintStatusFinishedAborted'). +-- +-- Note: when you enable print status tracking the print operation can be in +-- a non-finished state even after done has been called, as the operation +-- status then tracks the print job status on the printer. +-- +printOperationIsFinished :: PrintOperationClass self => self + -> IO Bool -- ^ returns @True@, if the print operation is finished. +printOperationIsFinished self = + liftM toBool $ + {# call gtk_print_operation_is_finished #} + (toPrintOperation self) + +-- | Runs a page setup dialog, letting the user modify the values from @pageSetup@. If the user cancels +-- the dialog, the returned 'PageSetup' is identical to the passed in @pageSetup@, otherwise it +-- contains the modifications done in the dialog. +-- +-- Note that this function may use a recursive mainloop to show the page setup dialog. See +-- 'printRunPageSetupDialogAsync' if this is a problem. +printRunPageSetupDialog :: (WindowClass window, PageSetupClass pageSetup, PrintSettingsClass setting) + => window -- ^ @parent@ transient parent. + -> pageSetup -- ^ @pageSetup@ an existing 'PageSetup'. + -> setting -- ^ @settings@ a 'PrintSettings' + -> IO PageSetup -- ^ returns a new 'PageSetup' +printRunPageSetupDialog window pageSetup setting = + wrapNewGObject mkPageSetup $ + {#call gtk_print_run_page_setup_dialog #} + (toWindow window) + (toPageSetup pageSetup) + (toPrintSettings setting) + +{#pointer PageSetupDoneFunc#} + +foreign import ccall "wrapper" mkGtkPageSetupDoneFunc :: + (Ptr PageSetup -> Ptr () -> IO ()) + -> IO PageSetupDoneFunc + +-- | Runs a page setup dialog, letting the user modify the values from @pageSetup@. +-- +-- In contrast to 'printRunPageSetupDialog', this function returns after showing the page setup +-- dialog on platforms that support this, and calls @doneCb@ from a signal handler for the 'response' +-- signal of the dialog. +printRunPageSetupDialogAsync :: (WindowClass window, PageSetupClass pageSetup, PrintSettingsClass setting) + => window -- ^ @parent@ transient parent. + -> pageSetup -- ^ @pageSetup@ an existing 'PageSetup'. + -> setting -- ^ @settings@ a 'PrintSettings' + -> (PageSetup -> IO ()) -- ^ @doneCb@ a function to call when the user saves the modified page setup + -> IO () +printRunPageSetupDialogAsync window pageSetup setting doneCb = do + funcPtr <- mkGtkPageSetupDoneFunc $ \setupPtr _ -> do + setup <- makeNewGObject mkPageSetup (return setupPtr) + doneCb setup + {#call gtk_print_run_page_setup_dialog_async #} + (toWindow window) + (toPageSetup pageSetup) + (toPrintSettings setting) + funcPtr + nullPtr + +-- | Ends a preview. +-- +-- This function must be called to finish a custom print preview. +printOperationPreviewEndPreview :: PrintOperationPreviewClass self + => self + -> IO () +printOperationPreviewEndPreview self = + {# call gtk_print_operation_preview_end_preview #} + (toPrintOperationPreview self) + +-- | Returns whether the given page is included in the set of pages that have been selected for printing. +printOperationPreviewIsSelected :: PrintOperationPreviewClass self + => self -- ^ @preview@ a 'PrintOperationPreview' + -> Int -- ^ @pageNr@ a page number + -> IO Bool -- ^ returns 'True' if the page has been selected for printing +printOperationPreviewIsSelected self pageNr = + liftM toBool $ + {# call gtk_print_operation_preview_is_selected #} + (toPrintOperationPreview self) + (fromIntegral pageNr) + +-- | Renders a page to the preview, using the print context that was passed to the "preview" handler +-- together with preview. +-- +-- A custom iprint preview should use this function in its 'expose' handler to render the currently +-- selected page. +-- +-- Note that this function requires a suitable cairo context to be associated with the print context. +printOperationPreviewRenderPage :: PrintOperationPreviewClass self + => self -- ^ @preview@ a 'PrintOperationPreview' + -> Int -- ^ @pageNr@ the page to render + -> IO () +printOperationPreviewRenderPage self pageNr = + {# call gtk_print_operation_preview_render_page #} + (toPrintOperationPreview self) + (fromIntegral pageNr) + +-------------------- +-- Attributes + +-- | The 'PageSetup' used by default. +-- +-- This page setup will be used by 'printOperationRun', but it can be overridden on a per-page +-- basis by connecting to the 'requestPageSetup' signal. +-- +-- Since 2.10 +printOperationDefaultPageSetup :: (PrintOperationClass self, PageSetupClass pageSetup) => ReadWriteAttr self PageSetup pageSetup +printOperationDefaultPageSetup = newAttrFromObjectProperty "default-page-setup" + {# call pure unsafe gtk_page_setup_get_type #} + +-- | The 'PrintSettings' used for initializing the dialog. +-- +-- Setting this property is typically used to re-establish print settings from a previous print +-- operation, see 'printOperationRun'. +-- +-- Since 2.10 +printOperationPrintSettings :: (PrintOperationClass self, PrintSettingsClass printSettings) => ReadWriteAttr self PrintSettings printSettings +printOperationPrintSettings = newAttrFromObjectProperty "print-settings" + {# call pure unsafe gtk_print_settings_get_type #} + +-- | A string used to identify the job (e.g. in monitoring applications like eggcups). +-- +-- If you don't set a job name, GTK+ picks a default one by numbering successive print jobs. +-- +-- Default value: \"\" +-- +-- Since 2.10 +printOperationJobName :: PrintOperationClass self => Attr self String +printOperationJobName = newAttrFromStringProperty "job-name" + +-- | The number of pages in the document. +-- +-- This must be set to a positive number before the rendering starts. It may be set in a 'beginPrint' +-- signal hander. +-- +-- Note that the page numbers passed to the 'requestPageSetup' and 'drawPage' signals are 0-based, +-- i.e. if the user chooses to print all pages, the last 'drawPage' signal will be for page @nPages@ - +-- 1. +-- +-- Allowed values: >= 'GMaxulong' +-- +-- Default value: -1 +-- +-- Since 2.10 +printOperationNPages :: PrintOperationClass self => Attr self Int +printOperationNPages = newAttrFromIntProperty "n-pages" + +-- | The current page in the document. +-- +-- If this is set before 'printOperationRun', the user will be able to select to print only the +-- current page. +-- +-- Note that this only makes sense for pre-paginated documents. +-- +-- Allowed values: >= 'GMaxulong' +-- +-- Default value: -1 +-- +-- Since 2.10 +printOperationCurrentPage :: PrintOperationClass self => Attr self Int +printOperationCurrentPage = newAttrFromIntProperty "current-page" + +-- | If 'True', the transformation for the cairo context obtained from 'PrintContext' puts the origin at +-- the top left corner of the page (which may not be the top left corner of the sheet, depending on +-- page orientation and the number of pages per sheet). Otherwise, the origin is at the top left corner +-- of the imageable area (i.e. inside the margins). +-- +-- Default value: 'False' +-- +-- Since 2.10 +printOperationUseFullPage :: PrintOperationClass self => Attr self Bool +printOperationUseFullPage = newAttrFromBoolProperty "use-full-page" + +-- | If 'True', the print operation will try to continue report on the status of the print job in the +-- printer queues and printer. This can allow your application to show things like "out of paper" +-- issues, and when the print job actually reaches the printer. However, this is often implemented +-- using polling, and should not be enabled unless needed. +-- +-- Default value: 'False' +-- +-- Since 2.10 +printOperationTrackPrintStatus :: PrintOperationClass self => Attr self Bool +printOperationTrackPrintStatus = newAttrFromBoolProperty "track-print-status" + +-- | The transformation for the cairo context obtained from 'PrintContext' is set up in such a way that +-- distances are measured in units of unit. +-- +-- Default value: ''UnitPixel'' +-- +-- Since 2.10 +-- +printOperationUnit :: PrintOperationClass self => Attr self Unit +printOperationUnit = newAttrFromEnumProperty "unit" + {# call pure unsafe gtk_unit_get_type #} + +-- | Determines whether to show a progress dialog during the print operation. +-- +-- Default value: 'False' +-- +-- Since 2.10 +printOperationShowProgress :: PrintOperationClass self => Attr self Bool +printOperationShowProgress = newAttrFromBoolProperty "show-progress" + +-- | Determines whether the print operation may run asynchronously or not. +-- +-- Some systems don't support asynchronous printing, but those that do will return +-- ''PrintOperationResultInProgress'' as the status, and emit the "done" signal when the operation +-- is actually done. +-- +-- The Windows port does not support asynchronous operation at all (this is unlikely to change). On +-- other platforms, all actions except for ''PrintOperationActionExport'' support asynchronous +-- operation. +-- +-- Default value: 'False' +-- +-- Since 2.10 +printOperationAllowAsync :: PrintOperationClass self => Attr self Bool +printOperationAllowAsync = newAttrFromBoolProperty "allow-async" + +-- | The name of a file to generate instead of showing the print dialog. Currently, PDF is the only +-- supported format. +-- +-- The intended use of this property is for implementing "Export to PDF" actions. +-- +-- "Print to PDF" support is independent of this and is done by letting the user pick the "Print to +-- PDF" item from the list of printers in the print dialog. +-- +-- Default value: 'Nothing' +-- +-- Since 2.10 +printOperationExportFilename :: PrintOperationClass self => Attr self String +printOperationExportFilename = newAttrFromStringProperty "export-filename" + +-- | The status of the print operation. +-- +-- Default value: ''PrintStatusInitial'' +-- +-- Since 2.10 +printOperationStatus :: PrintOperationClass self => ReadAttr self PrintStatus +printOperationStatus = readAttrFromEnumProperty "status" + {# call pure unsafe gtk_print_status_get_type #} + +-- | A string representation of the status of the print operation. The string is translated and suitable +-- for displaying the print status e.g. in a 'Statusbar'. +-- +-- See the 'printOperationStatus' property for a status value that is suitable for programmatic use. +-- +-- Default value: \"\" +-- +-- Since 2.10 +printOperationStatusString :: PrintOperationClass self => ReadAttr self String +printOperationStatusString = readAttrFromStringProperty "status-string" + +-- | Used as the label of the tab containing custom widgets. Note that this property may be ignored on +-- some platforms. +-- +-- If this is 'Nothing', GTK+ uses a default label. +-- +-- Default value: 'Nothing' +-- +-- Since 2.10 +printOperationCustomTabLabel :: PrintOperationClass self => Attr self String +printOperationCustomTabLabel = newAttrFromStringProperty "custom-tab-label" + +#if GTK_CHECK_VERSION(2,18,0) +-- | If 'True', the print operation will support print of selection. This allows the print dialog to show a +-- "Selection" button. +-- +-- Default value: 'False' +-- +-- Since 2.18 +printOperationSupportSelection :: PrintOperationClass self => Attr self Bool +printOperationSupportSelection = newAttrFromBoolProperty "support-selection" + +-- | Determines whether there is a selection in your application. This can allow your application to +-- print the selection. This is typically used to make a "Selection" button sensitive. +-- +-- Default value: 'False' +-- +-- Since 2.18 +printOperationHasSelection :: PrintOperationClass self => Attr self Bool +printOperationHasSelection = newAttrFromBoolProperty "has-selection" + +-- | If 'True', page size combo box and orientation combo box are embedded into page setup page. +-- +-- Default value: 'False' +-- +-- Since 2.18 +printOperationEmbedPageSetup :: PrintOperationClass self => Attr self Bool +printOperationEmbedPageSetup = newAttrFromBoolProperty "embed-page-setup" + +-- | The number of pages that will be printed. +-- +-- Note that this value is set during print preparation phase (''PrintStatusPreparing''), so this +-- value should never be get before the data generation phase (''PrintStatusGeneratingData''). You +-- can connect to the 'statusChanged' signal and call 'printOperationGetNPagesToPrint' when +-- print status is ''PrintStatusGeneratingData''. This is typically used to track the progress of +-- print operation. +-- +-- Allowed values: >= 'GMaxulong' +-- +-- Default value: -1 +-- +-- Since 2.18 +printOperationNPagesToPrint :: PrintOperationClass self => ReadAttr self Int +printOperationNPagesToPrint = readAttrFromIntProperty "n-pages-to-print" +#endif + +-------------------- +-- Signals + +-- | Emitted when the print operation run has finished doing everything +-- required for printing. +-- +-- @result@ gives you information about what happened during the run. If +-- @result@ is 'PrintOperationResultError' then you can call +-- 'printOperationGetError' for more information. +-- +-- If you enabled print status tracking then 'printOperationIsFinished' may +-- still return @False@ after 'done' was +-- emitted. +-- +printOptDone :: PrintOperationClass self => Signal self (PrintOperationResult -> IO ()) +printOptDone = Signal (connect_ENUM__NONE "done") + +-- | Emitted after the user has finished changing print settings in the +-- dialog, before the actual rendering starts. +-- +-- A typical use for 'begin-print' is to use the parameters from the +-- 'PrintContext' and paginate the document accordingly, and then set the +-- number of pages with 'printOperationSetNPages'. +-- +printOptBeginPrint :: PrintOperationClass self => Signal self (PrintContext -> IO ()) +printOptBeginPrint = Signal (connect_OBJECT__NONE "begin_print") + +-- | Emitted after the 'beginPrint' signal, +-- but before the actual rendering starts. It keeps getting emitted until a +-- connected signal handler returns @True@. +-- +-- The 'paginate' signal is intended to be used for paginating a document in +-- small chunks, to avoid blocking the user interface for a long time. The +-- signal handler should update the number of pages using +-- 'printOperationSetNPages', and return @True@ if the document has been +-- completely paginated. +-- +-- If you don't need to do pagination in chunks, you can simply do it all in +-- the 'begin-print handler', and set the number of pages from there. +-- +printOptPaginate :: PrintOperationClass self => Signal self (PrintContext -> IO Bool) +printOptPaginate = Signal (connect_OBJECT__BOOL "paginate") + +-- | Emitted once for every page that is printed, to give the application a +-- chance to modify the page setup. Any changes done to @setup@ will be in +-- force only for printing this page. +-- +printOptRequestPageSetup :: PrintOperationClass self => Signal self (PrintContext -> Int -> PageSetup -> IO ()) +printOptRequestPageSetup = Signal (connect_OBJECT_INT_OBJECT__NONE "request_page_setup") + +-- | Emitted for every page that is printed. The signal handler must render +-- the @pageNr@'s page onto the cairo context obtained from @context@ using +-- 'printContextGetCairoContext'. +-- +-- Use 'printOperationSetUseFullPage' and 'printOperationSetUnit' before +-- starting the print operation to set up the transformation of the cairo +-- context according to your needs. +-- +printOptDrawPage :: PrintOperationClass self => Signal self (PrintContext -> Int -> IO ()) +printOptDrawPage = Signal (connect_OBJECT_INT__NONE "draw_page") + +-- | Emitted after all pages have been rendered. A handler for this signal can +-- clean up any resources that have been allocated in the 'beginPrint' handler. +-- +printOptEndPrint :: PrintOperationClass self => Signal self (PrintContext -> IO ()) +printOptEndPrint = Signal (connect_OBJECT__NONE "end_print") + +-- | Emitted at between the various phases of the print operation. See +-- 'PrintStatus' for the phases that are being discriminated. Use +-- 'printOperationGetStatus' to find out the current status. +-- +printOptStatusChanged :: PrintOperationClass self => Signal self (IO ()) +printOptStatusChanged = Signal (connect_NONE__NONE "status_changed") + +-- | Emitted when displaying the print dialog. If you return a widget in a +-- handler for this signal it will be added to a custom tab in the print +-- dialog. You typically return a container widget with multiple widgets in it. +-- +-- The print dialog owns the returned widget, and its lifetime is not +-- controlled by the application. However, the widget is guaranteed to stay +-- around until the 'customWidgetApply' +-- signal is emitted on the operation. Then you can read out any information +-- you need from the widgets. +-- +printOptCreateCustomWidget :: PrintOperationClass self => Signal self (IO Widget) +printOptCreateCustomWidget = Signal (connect_NONE__OBJECTPTR "create_custom_widget") + +-- | Signal helper functions. +connect_NONE__OBJECTPTR :: + GObjectClass obj => SignalName -> + ConnectAfter -> obj -> + (IO Widget) -> + IO (ConnectId obj) +connect_NONE__OBJECTPTR signal after obj user = + connectGeneric signal after obj action + where action :: Ptr GObject -> IO (Ptr Widget) + action _ = + failOnGError $ do + x <- user + return $ unsafeForeignPtrToPtr (unWidget (toWidget x)) + +#if GTK_CHECK_VERSION(2,18,0) +-- | Emitted after change of selected printer. The actual page setup and print +-- settings are passed to the custom widget, which can actualize itself +-- according to this change. +-- +-- * Available since Gtk+ version 2.18 +-- +printOptUpdateCustomWidget :: PrintOperationClass self => Signal self (Widget -> PageSetup -> PrintSettings -> IO ()) +printOptUpdateCustomWidget = Signal (connect_OBJECT_OBJECT_OBJECT__NONE "update_custom_widget") +#endif + +-- | Emitted right before 'beginPrint' if you +-- added a custom widget in the 'createCustomWidtet' handler. When you get this signal you should read the +-- information from the custom widgets, as the widgets are not guaraneed to be +-- around at a later time. +-- +printOptCustomWidgetApply :: PrintOperationClass self => Signal self (Widget -> IO ()) +printOptCustomWidgetApply = Signal (connect_OBJECT__NONE "custom_widget_apply") + +-- | Gets emitted when a preview is requested from the native dialog. +-- +-- The default handler for this signal uses an external viewer application +-- to preview. +-- +-- To implement a custom print preview, an application must return @True@ +-- from its handler for this signal. In order to use the provided @context@ for +-- the preview implementation, it must be given a suitable cairo context with +-- 'printContextSetCairoContext'. +-- +-- The custom preview implementation can use +-- 'printOperationPreviewIsSelected' and 'printOperationPreviewRenderPage' to +-- find pages which are selected for print and render them. The preview must be +-- finished by calling 'printOperationPreviewEndPreview' (typically in response +-- to the user clicking a close button). +-- +printOptPreview :: PrintOperationClass self => Signal self (PrintOperationPreview -> PrintContext -> Window -> IO Bool) +printOptPreview = Signal (connect_OBJECT_OBJECT_OBJECT__BOOL "preview") + +-- | The 'ready' signal gets emitted once per preview operation, before the first page is rendered. +-- +-- A handler for this signal can be used for setup tasks. +printOptReady :: PrintOperationPreviewClass self => Signal self (PrintContext -> IO ()) +printOptReady = Signal (connect_OBJECT__NONE "ready") + +-- | The 'gotPageSize' signal is emitted once for each page that gets rendered to the preview. +-- +-- A handler for this signal should update the context according to @pageSetup@ and set up a suitable +-- cairo context, using 'printContextSetCairoContext'. +printOptGotPageSize :: PrintOperationPreviewClass self => Signal self (PrintContext -> PageSetup -> IO ()) +printOptGotPageSize = Signal (connect_OBJECT_OBJECT__NONE "got_page_size") +#endif diff --git a/Graphics/UI/Gtk/Printing/PrintSettings.chs b/Graphics/UI/Gtk/Printing/PrintSettings.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Printing/PrintSettings.chs @@ -0,0 +1,1074 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ScopedTypeVariables #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget PrintSettings +-- +-- Author : Andy Stewart +-- +-- Created: 28 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- Stores print settings +-- +-- * Module available since Gtk+ version 2.10 +-- +module Graphics.UI.Gtk.Printing.PrintSettings ( + +-- * Detail +-- +-- | A 'PrintSettings' object represents the settings of a print dialog in a +-- system-independent way. The main use for this object is that once you\'ve +-- printed you can get a settings object that represents the settings the user +-- chose, and the next time you print you can pass that object in so that the +-- user doesn't have to re-set all his settings. +-- +-- Its also possible to enumerate the settings so that you can easily save +-- the settings for the next time your app runs, or even store them in a +-- document. The predefined keys try to use shared values as much as possible +-- so that moving such a document between systems still works. +-- +-- Printing support was added in Gtk+ 2.10. +-- + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----PrintSettings +-- @ + +#if GTK_CHECK_VERSION(2,10,0) +-- * Types + PrintSettings, + PrintSettingsClass, + castToPrintSettings, + toPrintSettings, + -- PageRange, + +-- * Enums + PageOrientation(..), +#if GTK_CHECK_VERSION(2,14,0) + NumberUpLayout(..), +#endif + PrintQuality(..), + PrintDuplex(..), + PrintPages(..), + PageSet(..), + +-- * Constructors + printSettingsNew, +#if GTK_CHECK_VERSION(2,12,0) + printSettingsNewFromFile, +#endif + +-- * Methods + printSettingsCopy, + printSettingsHasKey, + printSettingsGet, + printSettingsSet, + printSettingsUnset, + printSettingsForeach, + printSettingsGetBool, + printSettingsSetBool, + printSettingsGetDouble, + printSettingsGetDoubleWithDefault, + printSettingsSetDouble, + printSettingsGetLength, + printSettingsSetLength, + printSettingsGetInt, + printSettingsGetIntWithDefault, + printSettingsSetInt, + printSettingsGetPaperWidth, + printSettingsSetPaperWidth, + printSettingsGetPaperHeight, + printSettingsSetPaperHeight, +#if GTK_CHECK_VERSION(2,16,0) + printSettingsSetResolutionXy, + printSettingsGetResolutionX, + printSettingsGetResolutionY, +#endif + -- printSettingsGetPageRanges, + -- printSettingsSetPageRanges, +#if GTK_CHECK_VERSION(2,14,0) + printSettingsLoadFile, +#endif +#if GTK_CHECK_VERSION(2,12,0) + printSettingsToFile, +#endif + +-- * Attributes + printSettingsPrinter, + printSettingsOrientation, + printSettingsPaperSize, + printSettingsUseColor, + printSettingsCollate, + printSettingsReverse, + printSettingsDuplex, + printSettingsQuality, + printSettingsNCopies, + printSettingsNumberUp, + printSettingsResolution, + printSettingsScale, + printSettingsPrintPages, + printSettingsPageSet, + printSettingsDefaultSource, + printSettingsMediaType, + printSettingsDither, + printSettingsFinishings, + printSettingsOutputBin, +#if GTK_CHECK_VERSION(2,14,0) + printSettingsNumberUpLayout, +#endif +#if GTK_CHECK_VERSION(2,16,0) + printSettingsPrinterLpi, +#endif +#endif + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.Attributes +import System.Glib.Properties +import System.Glib.UTFString +import System.Glib.GError +{#import Graphics.UI.Gtk.Types#} +import Graphics.UI.Gtk.Printing.PaperSize (PaperSize(PaperSize), mkPaperSize, Unit(..)) + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,10,0) +-------------------- +-- Enums +{#enum PageOrientation {underscoreToCase} deriving (Bounded,Eq,Show)#} + +{#enum PrintQuality {underscoreToCase} deriving (Bounded,Eq,Show)#} + +{#enum PrintDuplex {underscoreToCase} deriving (Bounded,Eq,Show)#} + +{#enum PrintPages {underscoreToCase} deriving (Bounded,Eq,Show)#} + +{#enum PageSet {underscoreToCase} deriving (Bounded,Eq,Show)#} + +#if GTK_CHECK_VERSION(2,14,0) +-- | Used to determine the layout of pages on a sheet when printing multiple pages per sheet. +{#enum NumberUpLayout {underscoreToCase} deriving (Bounded,Eq,Show)#} +#endif + +-------------------- +-- Constructors + +-- | Creates a new 'PrintSettings' object. +-- +printSettingsNew :: IO PrintSettings +printSettingsNew = + wrapNewGObject mkPrintSettings $ + {# call gtk_print_settings_new #} + +#if GTK_CHECK_VERSION(2,12,0) +-- | Reads the print settings from @fileName@. Returns a new 'PrintSettings' +-- object with the restored settings. +-- +-- * Available since Gtk+ version 2.12 +-- +printSettingsNewFromFile :: + String -- ^ @fileName@ - the filename to read the settings from + -> IO PrintSettings +printSettingsNewFromFile fileName = + wrapNewGObject mkPrintSettings $ + propagateGError $ \errorPtr -> + withUTFString fileName $ \fileNamePtr -> + {# call gtk_print_settings_new_from_file #} + fileNamePtr + errorPtr + +#endif + +-------------------- +-- Methods + +-- | Copies a 'PrintSettings' object. +-- +printSettingsCopy :: PrintSettingsClass self => self + -> IO PrintSettings -- ^ returns a newly allocated copy of @other@ +printSettingsCopy self = + wrapNewGObject mkPrintSettings $ + {# call gtk_print_settings_copy #} + (toPrintSettings self) + +-- | Returns @True@, if a value is associated with @key@. +-- +printSettingsHasKey :: PrintSettingsClass self => self + -> String -- ^ @key@ - a key + -> IO Bool -- ^ returns @True@, if @key@ has a value +printSettingsHasKey self key = + liftM toBool $ + withUTFString key $ \keyPtr -> + {# call gtk_print_settings_has_key #} + (toPrintSettings self) + keyPtr + +-- | Looks up the string value associated with @key@. +-- +printSettingsGet :: PrintSettingsClass self => self + -> String -- ^ @key@ - a key + -> IO String -- ^ returns the string value for @key@ +printSettingsGet self key = + withUTFString key $ \keyPtr -> + {# call gtk_print_settings_get #} + (toPrintSettings self) + keyPtr + >>= peekUTFString + +-- | Associates @value@ with @key@. +-- +printSettingsSet :: PrintSettingsClass self => self + -> String -- ^ @key@ - a key + -> String -- ^ @value@ - a string value + -> IO () +printSettingsSet self key value = + withUTFString value $ \valuePtr -> + withUTFString key $ \keyPtr -> + {# call gtk_print_settings_set #} + (toPrintSettings self) + keyPtr + valuePtr + +-- | Removes any value associated with @key@ +-- +printSettingsUnset :: PrintSettingsClass self => self + -> String -- ^ @key@ - a key + -> IO () +printSettingsUnset self key = + withUTFString key $ \keyPtr -> + {# call gtk_print_settings_unset #} + (toPrintSettings self) + keyPtr + +-- | Calls @func@ for each key-value pair of @settings@. +-- +printSettingsForeach :: PrintSettingsClass self => self + -> (String -> IO ()) -- ^ @func@ - the function to call + -> IO () +printSettingsForeach self func = do + funcPtr <- mkPrintSettingsFunc $ \_ strPtr _ -> do + str <- peekCString strPtr + func str + {# call gtk_print_settings_foreach #} + (toPrintSettings self) + funcPtr + (castFunPtrToPtr funcPtr) + +{#pointer PrintSettingsFunc#} + +foreign import ccall "wrapper" mkPrintSettingsFunc :: + (CString -> CString -> Ptr () -> IO ()) + -> IO PrintSettingsFunc + +-- | Returns the boolean represented by the value that is associated with +-- @key@. +-- +-- The string \"true\" represents @True@, any other string @False@. +-- +printSettingsGetBool :: PrintSettingsClass self => self + -> String -- ^ @key@ - a key + -> IO Bool -- ^ returns @True@, if @key@ maps to a true value. +printSettingsGetBool self key = + liftM toBool $ + withUTFString key $ \keyPtr -> + {# call gtk_print_settings_get_bool #} + (toPrintSettings self) + keyPtr + +-- | Sets @key@ to a boolean value. +-- +printSettingsSetBool :: PrintSettingsClass self => self + -> String -- ^ @key@ - a key + -> Bool -- ^ @value@ - a boolean + -> IO () +printSettingsSetBool self key value = + withUTFString key $ \keyPtr -> + {# call gtk_print_settings_set_bool #} + (toPrintSettings self) + keyPtr + (fromBool value) + +-- | Returns the double value associated with @key@, or 0. +-- +printSettingsGetDouble :: PrintSettingsClass self => self + -> String -- ^ @key@ - a key + -> IO Double -- ^ returns the double value of @key@ +printSettingsGetDouble self key = + liftM realToFrac $ + withUTFString key $ \keyPtr -> + {# call gtk_print_settings_get_double #} + (toPrintSettings self) + keyPtr + +-- | Returns the floating point number represented by the value that is +-- associated with @key@, or @defaultVal@ if the value does not represent a +-- floating point number. +-- +-- Floating point numbers are parsed with 'gAsciiStrtod'. +-- +printSettingsGetDoubleWithDefault :: PrintSettingsClass self => self + -> String -- ^ @key@ - a key + -> Double -- ^ @def@ - the default value + -> IO Double -- ^ returns the floating point number associated with @key@ +printSettingsGetDoubleWithDefault self key def = + liftM realToFrac $ + withUTFString key $ \keyPtr -> + {# call gtk_print_settings_get_double_with_default #} + (toPrintSettings self) + keyPtr + (realToFrac def) + +-- | Sets @key@ to a double value. +-- +printSettingsSetDouble :: PrintSettingsClass self => self + -> String -- ^ @key@ - a key + -> Double -- ^ @value@ - a double value + -> IO () +printSettingsSetDouble self key value = + withUTFString key $ \keyPtr -> + {# call gtk_print_settings_set_double #} + (toPrintSettings self) + keyPtr + (realToFrac value) + +-- | Returns the value associated with @key@, interpreted as a length. The +-- returned value is converted to @units@. +-- +printSettingsGetLength :: PrintSettingsClass self => self + -> String -- ^ @key@ - a key + -> Unit -- ^ @unit@ - the unit of the return value + -> IO Double -- ^ returns the length value of @key@, converted to @unit@ +printSettingsGetLength self key unit = + liftM realToFrac $ + withUTFString key $ \keyPtr -> + {# call gtk_print_settings_get_length #} + (toPrintSettings self) + keyPtr + ((fromIntegral . fromEnum) unit) + +-- | Associates a length in units of @unit@ with @key@. +-- +printSettingsSetLength :: PrintSettingsClass self => self + -> String -- ^ @key@ - a key + -> Double -- ^ @value@ - a length + -> Unit -- ^ @unit@ - the unit of @length@ + -> IO () +printSettingsSetLength self key value unit = + withUTFString key $ \keyPtr -> + {# call gtk_print_settings_set_length #} + (toPrintSettings self) + keyPtr + (realToFrac value) + ((fromIntegral . fromEnum) unit) + +-- | Returns the integer value of @key@, or 0. +-- +printSettingsGetInt :: PrintSettingsClass self => self + -> String -- ^ @key@ - a key + -> IO Int -- ^ returns the integer value of @key@ +printSettingsGetInt self key = + liftM fromIntegral $ + withUTFString key $ \keyPtr -> + {# call gtk_print_settings_get_int #} + (toPrintSettings self) + keyPtr + +-- | Returns the value of @key@, interpreted as an integer, or the default +-- value. +-- +printSettingsGetIntWithDefault :: PrintSettingsClass self => self + -> String -- ^ @key@ - a key + -> Int -- ^ @def@ - the default value + -> IO Int -- ^ returns the integer value of @key@ +printSettingsGetIntWithDefault self key def = + liftM fromIntegral $ + withUTFString key $ \keyPtr -> + {# call gtk_print_settings_get_int_with_default #} + (toPrintSettings self) + keyPtr + (fromIntegral def) + +-- | Sets @key@ to an integer value. +-- +printSettingsSetInt :: PrintSettingsClass self => self + -> String -- ^ @key@ - a key + -> Int -- ^ @value@ - an integer + -> IO () +printSettingsSetInt self key value = + withUTFString key $ \keyPtr -> + {# call gtk_print_settings_set_int #} + (toPrintSettings self) + keyPtr + (fromIntegral value) + +-- | Convenience function to obtain the value of ''PrintSettingsPrinter''. +printSettingsGetPrinter :: PrintSettingsClass self => self + -> IO String -- ^ returns the printer name +printSettingsGetPrinter self = + {# call gtk_print_settings_get_printer #} + (toPrintSettings self) + >>= peekUTFString + +-- | Convenience function to obtain the value of ''PrintSettingsPrinter''. +printSettingsSetPrinter :: PrintSettingsClass self => self + -> String -- ^ @printer@ - the printer name + -> IO () +printSettingsSetPrinter self printer = + withUTFString printer $ \printerPtr -> + {# call gtk_print_settings_set_printer #} + (toPrintSettings self) + printerPtr + +-- | Get the value of ''PrintSettingsOrientation'', converted to a 'PageOrientation'. +printSettingsGetOrientation :: PrintSettingsClass self => self + -> IO PageOrientation -- ^ returns the orientation +printSettingsGetOrientation self = + liftM (toEnum . fromIntegral) $ + {# call gtk_print_settings_get_orientation #} + (toPrintSettings self) + +-- | Sets the value of ''PrintSettingsOrientation''. +printSettingsSetOrientation :: PrintSettingsClass self => self + -> PageOrientation -- ^ @orientation@ - a page orientation + -> IO () +printSettingsSetOrientation self orientation = + {# call gtk_print_settings_set_orientation #} + (toPrintSettings self) + ((fromIntegral . fromEnum) orientation) + +-- | Gets the value of 'PrintSettingsPaperFormat', converted to a 'PaperSize'. +printSettingsGetPaperSize :: PrintSettingsClass self => self + -> IO PaperSize -- ^ returns the paper size +printSettingsGetPaperSize self = + {# call gtk_print_settings_get_paper_size #} + (toPrintSettings self) + >>= mkPaperSize . castPtr + +-- | Sets the value of 'PrintSettingsPaperFormat', 'PrintSettingsPaperWidth' and +-- 'PrintSettingsPaperHeight'. +printSettingsSetPaperSize :: PrintSettingsClass self => self + -> PaperSize -- ^ @paperSize@ - a paper size + -> IO () +printSettingsSetPaperSize self (PaperSize paperSize) = + {# call gtk_print_settings_set_paper_size #} + (toPrintSettings self) + (castPtr $ unsafeForeignPtrToPtr $ paperSize) + +-- | Gets the value of 'PrintSettingsPaperWidth', converted to unit. +-- +printSettingsGetPaperWidth :: PrintSettingsClass self => self + -> Unit -- ^ @unit@ - the unit for the return value + -> IO Double -- ^ returns the paper width, in units of @unit@ +printSettingsGetPaperWidth self unit = + liftM realToFrac $ + {# call gtk_print_settings_get_paper_width #} + (toPrintSettings self) + ((fromIntegral . fromEnum) unit) + +-- | Sets the value of 'PrintSettingsPaperWidth'. +-- +printSettingsSetPaperWidth :: PrintSettingsClass self => self + -> Double -- ^ @width@ - the paper width + -> Unit -- ^ @unit@ - the units of @width@ + -> IO () +printSettingsSetPaperWidth self width unit = + {# call gtk_print_settings_set_paper_width #} + (toPrintSettings self) + (realToFrac width) + ((fromIntegral . fromEnum) unit) + +-- | Gets the value of 'PrintSettingsPaperHeight', converted to unit. +-- +printSettingsGetPaperHeight :: PrintSettingsClass self => self + -> Unit -- ^ @unit@ - the unit for the return value + -> IO Double -- ^ returns the paper height, in units of @unit@ +printSettingsGetPaperHeight self unit = + liftM realToFrac $ + {# call gtk_print_settings_get_paper_height #} + (toPrintSettings self) + ((fromIntegral . fromEnum) unit) + +-- | Sets the value of 'PrintSettingsPaperHeight'. +-- +printSettingsSetPaperHeight :: PrintSettingsClass self => self + -> Double -- ^ @height@ - the paper height + -> Unit -- ^ @unit@ - the units of @height@ + -> IO () +printSettingsSetPaperHeight self height unit = + {# call gtk_print_settings_set_paper_height #} + (toPrintSettings self) + (realToFrac height) + ((fromIntegral . fromEnum) unit) + +-- | Gets the value of ''PrintSettingsUseColor''. +printSettingsGetUseColor :: PrintSettingsClass self => self + -> IO Bool -- ^ returns whether to use color +printSettingsGetUseColor self = + liftM toBool $ + {# call gtk_print_settings_get_use_color #} + (toPrintSettings self) + +-- | Sets the value of ''PrintSettingsUseColor''. +printSettingsSetUseColor :: PrintSettingsClass self => self + -> Bool -- ^ @useColor@ - whether to use color + -> IO () +printSettingsSetUseColor self useColor = + {# call gtk_print_settings_set_use_color #} + (toPrintSettings self) + (fromBool useColor) + +-- | Gets the value of ''PrintSettingsCollate''. +printSettingsGetCollate :: PrintSettingsClass self => self + -> IO Bool -- ^ returns whether to collate the printed pages +printSettingsGetCollate self = + liftM toBool $ + {# call gtk_print_settings_get_collate #} + (toPrintSettings self) + +-- | Sets the value of ''PrintSettingsCollate''. +printSettingsSetCollate :: PrintSettingsClass self => self + -> Bool -- ^ @collate@ - whether to collate the output + -> IO () +printSettingsSetCollate self collate = + {# call gtk_print_settings_set_collate #} + (toPrintSettings self) + (fromBool collate) + +-- | Gets the value of ''PrintSettingsReverse''. +printSettingsGetReverse :: PrintSettingsClass self => self + -> IO Bool -- ^ returns whether to reverse the order of the printed pages +printSettingsGetReverse self = + liftM toBool $ + {# call gtk_print_settings_get_reverse #} + (toPrintSettings self) + +-- | Sets the value of ''PrintSettingsReverse''. +printSettingsSetReverse :: PrintSettingsClass self => self + -> Bool -- ^ @reverse@ - whether to reverse the output + -> IO () +printSettingsSetReverse self reverse = + {# call gtk_print_settings_set_reverse #} + (toPrintSettings self) + (fromBool reverse) + +-- | Gets the value of ''PrintSettingsDuplex''. +printSettingsGetDuplex :: PrintSettingsClass self => self + -> IO PrintDuplex -- ^ returns whether to print the output in duplex. +printSettingsGetDuplex self = + liftM (toEnum . fromIntegral) $ + {# call gtk_print_settings_get_duplex #} + (toPrintSettings self) + +-- | Sets the value of 'PrintSettingsDuplex'. +printSettingsSetDuplex :: PrintSettingsClass self => self + -> PrintDuplex -- ^ @duplex@ - a 'PrintDuplex' value + -> IO () +printSettingsSetDuplex self duplex = + {# call gtk_print_settings_set_duplex #} + (toPrintSettings self) + ((fromIntegral . fromEnum) duplex) + +-- | Gets the value of 'PrintSettingsQuality'. +printSettingsGetQuality :: PrintSettingsClass self => self + -> IO PrintQuality -- ^ returns the print quality +printSettingsGetQuality self = + liftM (toEnum . fromIntegral) $ + {# call gtk_print_settings_get_quality #} + (toPrintSettings self) + +-- | Sets the value of 'PrintSettingsQuality'. +printSettingsSetQuality :: PrintSettingsClass self => self + -> PrintQuality -- ^ @quality@ - a 'PrintQuality' value + -> IO () +printSettingsSetQuality self quality = + {# call gtk_print_settings_set_quality #} + (toPrintSettings self) + ((fromIntegral . fromEnum) quality) + +-- | Gets the value of 'PrintSettingsNCopies'. +printSettingsGetNCopies :: PrintSettingsClass self => self + -> IO Int -- ^ returns the number of copies to print +printSettingsGetNCopies self = + liftM fromIntegral $ + {# call gtk_print_settings_get_n_copies #} + (toPrintSettings self) + +-- | Sets the value of 'PrintSettingsNCopies'. +printSettingsSetNCopies :: PrintSettingsClass self => self + -> Int -- ^ @numCopies@ - the number of copies + -> IO () +printSettingsSetNCopies self numCopies = + {# call gtk_print_settings_set_n_copies #} + (toPrintSettings self) + (fromIntegral numCopies) + +-- | Gets the value of 'PrintSettingsNumberUp'. +printSettingsGetNumberUp :: PrintSettingsClass self => self + -> IO Int -- ^ returns the number of pages per sheet +printSettingsGetNumberUp self = + liftM fromIntegral $ + {# call gtk_print_settings_get_number_up #} + (toPrintSettings self) + +-- | Sets the value of 'PrintSettingsNumberUp'. +printSettingsSetNumberUp :: PrintSettingsClass self => self + -> Int -- ^ @numberUp@ - the number of pages per sheet + -> IO () +printSettingsSetNumberUp self numberUp = + {# call gtk_print_settings_set_number_up #} + (toPrintSettings self) + (fromIntegral numberUp) + +#if GTK_CHECK_VERSION(2,14,0) +-- | Gets the value of 'PrintSettingsNumberUpLayout'. +printSettingsGetNumberUpLayout :: PrintSettingsClass self => self + -> IO NumberUpLayout -- ^ returns layout of page in number-up mode +printSettingsGetNumberUpLayout self = + liftM (toEnum . fromIntegral) $ + {# call gtk_print_settings_get_number_up_layout #} + (toPrintSettings self) + +-- | Sets the value of 'PrintSettingsNumberUpLayout'. +printSettingsSetNumberUpLayout :: PrintSettingsClass self => self + -> NumberUpLayout -- ^ @numberUpLayout@ - a 'NumberUpLayout' value + -> IO () +printSettingsSetNumberUpLayout self numberUpLayout = + {# call gtk_print_settings_set_number_up_layout #} + (toPrintSettings self) + ((fromIntegral . fromEnum) numberUpLayout) +#endif + +-- | Gets the value of 'PrintSettingsResolution'. +printSettingsGetResolution :: PrintSettingsClass self => self + -> IO Int -- ^ returns the resolution in dpi +printSettingsGetResolution self = + liftM fromIntegral $ + {# call gtk_print_settings_get_resolution #} + (toPrintSettings self) + +-- | Sets the values of 'PrintSettingsResolution', 'PrintSettingsResolutionX' and +-- 'PrintSettingsResolutionY'. +printSettingsSetResolution :: PrintSettingsClass self => self + -> Int -- ^ @resolution@ - the resolution in dpi + -> IO () +printSettingsSetResolution self resolution = + {# call gtk_print_settings_set_resolution #} + (toPrintSettings self) + (fromIntegral resolution) +#endif + +#if GTK_CHECK_VERSION(2,16,0) +-- | Sets the values of 'PrintSettingsResolution', 'PrintSettingsResolutionX' and +-- 'PrintSettingsResolutionY'. +-- +-- * Available since Gtk+ version 2.16 +-- +printSettingsSetResolutionXy :: PrintSettingsClass self => self + -> Int -- ^ @resolutionX@ - the horizontal resolution in dpi + -> Int -- ^ @resolutionY@ - the vertical resolution in dpi + -> IO () +printSettingsSetResolutionXy self resolutionX resolutionY = + {# call gtk_print_settings_set_resolution_xy #} + (toPrintSettings self) + (fromIntegral resolutionX) + (fromIntegral resolutionY) + +-- | Gets the value of @GTK_PRINT_SETTINGS_RESOLUTION_X@. +-- +-- * Available since Gtk+ version 2.16 +-- +printSettingsGetResolutionX :: PrintSettingsClass self => self + -> IO Int -- ^ returns the horizontal resolution in dpi +printSettingsGetResolutionX self = + liftM fromIntegral $ + {# call gtk_print_settings_get_resolution_x #} + (toPrintSettings self) + +-- | Gets the value of @GTK_PRINT_SETTINGS_RESOLUTION_Y@. +-- +-- * Available since Gtk+ version 2.16 +-- +printSettingsGetResolutionY :: PrintSettingsClass self => self + -> IO Int -- ^ returns the vertical resolution in dpi +printSettingsGetResolutionY self = + liftM fromIntegral $ + {# call gtk_print_settings_get_resolution_y #} + (toPrintSettings self) + +-- | Gets the value of 'PrintSettingsPrinterLpi'. +printSettingsGetPrinterLpi :: PrintSettingsClass self => self + -> IO Double -- ^ returns the resolution in lpi (lines per inch) +printSettingsGetPrinterLpi self = + liftM realToFrac $ + {# call gtk_print_settings_get_printer_lpi #} + (toPrintSettings self) + +-- | Sets the value of 'PrintSettingsPrinterLpi'. +printSettingsSetPrinterLpi :: PrintSettingsClass self => self + -> Double -- ^ @lpi@ - the resolution in lpi (lines per inch) + -> IO () +printSettingsSetPrinterLpi self lpi = + {# call gtk_print_settings_set_printer_lpi #} + (toPrintSettings self) + (realToFrac lpi) + +-- | Gets the value of 'PrintSettingsScale'. +printSettingsGetScale :: PrintSettingsClass self => self + -> IO Double -- ^ returns the scale in percent +printSettingsGetScale self = + liftM realToFrac $ + {# call gtk_print_settings_get_scale #} + (toPrintSettings self) + +-- | Sets the value of 'PrintSettingsScale'. +printSettingsSetScale :: PrintSettingsClass self => self + -> Double -- ^ @scale@ - the scale in percent + -> IO () +printSettingsSetScale self scale = + {# call gtk_print_settings_set_scale #} + (toPrintSettings self) + (realToFrac scale) + +-- | Gets the value of 'PrintSettingsPrintPages'. +printSettingsGetPrintPages :: PrintSettingsClass self => self + -> IO PrintPages -- ^ returns which pages to print +printSettingsGetPrintPages self = + liftM (toEnum . fromIntegral) $ + {# call gtk_print_settings_get_print_pages #} + (toPrintSettings self) + +-- | Sets the value of 'PrintSettingsPrintPages'. +printSettingsSetPrintPages :: PrintSettingsClass self => self + -> PrintPages -- ^ @pages@ - a 'PrintPages' value + -> IO () +printSettingsSetPrintPages self pages = + {# call gtk_print_settings_set_print_pages #} + (toPrintSettings self) + ((fromIntegral . fromEnum) pages) +#endif + +-- | Gets the value of 'PrintSettingsPageRanges'. +-- +-- printSettingsGetPageRanges :: PrintSettingsClass self => self +-- -> IO [PageRange] -- ^ returns an array of 'PageRange'. +-- printSettingsGetPageRanges self = +-- alloca $ \numRangesPtr -> do +-- rangeListPtr <- {# call gtk_print_settings_get_page_ranges #} +-- (toPrintSettings self) +-- numRangesPtr +-- rangeLen <- peek numRangesPtr +-- ptrList <- peekArray (fromIntegral rangeLen) (castPtr rangeListPtr) +-- rangeList <- mapM peek ptrList +-- {#call unsafe g_free#} (castPtr rangeListPtr) +-- return rangeList + +-- | Sets the value of @GTK_PRINT_SETTINGS_PAGE_RANGES@. +-- +-- printSettingsSetPageRanges :: PrintSettingsClass self => self +-- -> [PageRange] -- ^ @pageRanges@ - an array of 'PageRange' +-- -> IO () +-- printSettingsSetPageRanges self rangeList = +-- withArrayLen (concatMap (\(PageRange x y) -> [fromIntegral x, fromIntegral y]) rangeList) +-- $ \rangeLen rangeListPtr -> +-- {# call gtk_print_settings_set_page_ranges #} +-- (toPrintSettings self) +-- (castPtr rangeListPtr) +-- (fromIntegral rangeLen) + +-- | Gets the value of 'PrintSettingsPageSet'. +printSettingsGetPageSet :: PrintSettingsClass self => self + -> IO PageSet -- ^ returns the set of pages to print +printSettingsGetPageSet self = + liftM (toEnum . fromIntegral) $ + {# call gtk_print_settings_get_page_set #} + (toPrintSettings self) + +-- | Sets the value of 'PrintSettingsPageSet'. +printSettingsSetPageSet :: PrintSettingsClass self => self + -> PageSet -- ^ @pageSet@ - a 'PageSet' value + -> IO () +printSettingsSetPageSet self pageSet = + {# call gtk_print_settings_set_page_set #} + (toPrintSettings self) + ((fromIntegral . fromEnum) pageSet) + +-- | Gets the value of 'PrintSettingsDefaultSource'. +printSettingsGetDefaultSource :: PrintSettingsClass self => self + -> IO String -- ^ returns the default source +printSettingsGetDefaultSource self = + {# call gtk_print_settings_get_default_source #} + (toPrintSettings self) + >>= peekUTFString + +-- | Sets the value of 'PrintSettingsDefaultSource'. +printSettingsSetDefaultSource :: PrintSettingsClass self => self + -> String -- ^ @defaultSource@ - the default source + -> IO () +printSettingsSetDefaultSource self defaultSource = + withUTFString defaultSource $ \defaultSourcePtr -> + {# call gtk_print_settings_set_default_source #} + (toPrintSettings self) + defaultSourcePtr + +-- | Gets the value of 'PrintSettingsMediaType'. +printSettingsGetMediaType :: PrintSettingsClass self => self + -> IO String -- ^ returns the media type +printSettingsGetMediaType self = + {# call gtk_print_settings_get_media_type #} + (toPrintSettings self) + >>= peekUTFString + +-- | Sets the value of 'PrintSettingsMediaType'. +printSettingsSetMediaType :: PrintSettingsClass self => self + -> String -- ^ @mediaType@ - the media type + -> IO () +printSettingsSetMediaType self mediaType = + withUTFString mediaType $ \mediaTypePtr -> + {# call gtk_print_settings_set_media_type #} + (toPrintSettings self) + mediaTypePtr + +-- | Gets the value of 'PrintSettingsDither'. +printSettingsGetDither :: PrintSettingsClass self => self + -> IO String -- ^ returns the dithering that is used +printSettingsGetDither self = + {# call gtk_print_settings_get_dither #} + (toPrintSettings self) + >>= peekUTFString + +-- | Sets the value of 'PrintSettingsDither'. +printSettingsSetDither :: PrintSettingsClass self => self + -> String -- ^ @dither@ - the dithering that is used + -> IO () +printSettingsSetDither self dither = + withUTFString dither $ \ditherPtr -> + {# call gtk_print_settings_set_dither #} + (toPrintSettings self) + ditherPtr + +-- | Gets the value of 'PrintSettingsFinishings'. +printSettingsGetFinishings :: PrintSettingsClass self => self + -> IO String -- ^ returns the finishings +printSettingsGetFinishings self = + {# call gtk_print_settings_get_finishings #} + (toPrintSettings self) + >>= peekUTFString + +-- | Sets the value of 'PrintSettingsFinishings'. +printSettingsSetFinishings :: PrintSettingsClass self => self + -> String -- ^ @finishings@ - the finishings + -> IO () +printSettingsSetFinishings self finishings = + withUTFString finishings $ \finishingsPtr -> + {# call gtk_print_settings_set_finishings #} + (toPrintSettings self) + finishingsPtr + +-- | Gets the value of 'PrintSettingsOutputBin'. +printSettingsGetOutputBin :: PrintSettingsClass self => self + -> IO String -- ^ returns the output bin +printSettingsGetOutputBin self = + {# call gtk_print_settings_get_output_bin #} + (toPrintSettings self) + >>= peekUTFString + +-- | Sets the value of 'PrintSettingsOutputBin'. +printSettingsSetOutputBin :: PrintSettingsClass self => self + -> String -- ^ @outputBin@ - the output bin + -> IO () +printSettingsSetOutputBin self outputBin = + withUTFString outputBin $ \outputBinPtr -> + {# call gtk_print_settings_set_output_bin #} + (toPrintSettings self) + outputBinPtr + + +#if GTK_CHECK_VERSION(2,14,0) +-- | Reads the print settings from @fileName@. See 'printSettingsToFile'. +-- +-- * Available since Gtk+ version 2.14 +-- +printSettingsLoadFile :: PrintSettingsClass self => self + -> String -- ^ @fileName@ - the filename to read the settings from + -> IO Bool -- ^ returns @True@ on success +printSettingsLoadFile self fileName = + liftM toBool $ + propagateGError $ \errorPtr -> + withUTFString fileName $ \fileNamePtr -> + {# call gtk_print_settings_load_file #} + (toPrintSettings self) + fileNamePtr + errorPtr + +#endif + +#if GTK_CHECK_VERSION(2,12,0) +-- | This function saves the print settings from @settings@ to @fileName@. +-- +-- * Available since Gtk+ version 2.12 +-- +printSettingsToFile :: PrintSettingsClass self => self + -> String -- ^ @fileName@ - the file to save to + -> IO Bool -- ^ returns @True@ on success +printSettingsToFile self fileName = + liftM toBool $ + propagateGError $ \errorPtr -> + withUTFString fileName $ \fileNamePtr -> + {# call gtk_print_settings_to_file #} + (toPrintSettings self) + fileNamePtr + errorPtr + +-- | Obtain the value of 'PrintSettingsPrinter'. +printSettingsPrinter :: PrintSettingsClass self => Attr self String +printSettingsPrinter = newAttr + printSettingsGetPrinter + printSettingsSetPrinter + +-- | The value of ''PrintSettingsOrientation'', converted to a 'PageOrientation'. +printSettingsOrientation :: PrintSettingsClass self => Attr self PageOrientation +printSettingsOrientation = newAttr + printSettingsGetOrientation + printSettingsSetOrientation + +-- | The value of 'PrintSettingsPaperFormat', converted to a 'PaperSize'. +printSettingsPaperSize :: PrintSettingsClass self => Attr self PaperSize +printSettingsPaperSize = newAttr + printSettingsGetPaperSize + printSettingsSetPaperSize + +-- | The value of ''PrintSettingsUseColor''. +printSettingsUseColor :: PrintSettingsClass self => Attr self Bool +printSettingsUseColor = newAttr + printSettingsGetUseColor + printSettingsSetUseColor + +-- | The value of ''PrintSettingsCollate''. +printSettingsCollate :: PrintSettingsClass self => Attr self Bool +printSettingsCollate = newAttr + printSettingsGetCollate + printSettingsSetCollate + +-- | The value of ''PrintSettingsReverse''. +printSettingsReverse :: PrintSettingsClass self => Attr self Bool +printSettingsReverse = newAttr + printSettingsGetReverse + printSettingsSetReverse + +-- | The value of ''PrintSettingsDuplex''. +printSettingsDuplex :: PrintSettingsClass self => Attr self PrintDuplex +printSettingsDuplex = newAttr + printSettingsGetDuplex + printSettingsSetDuplex + +-- | The value of ''PrintSettingsQuality''. +printSettingsQuality :: PrintSettingsClass self => Attr self PrintQuality +printSettingsQuality = newAttr + printSettingsGetQuality + printSettingsSetQuality + +-- | The value of 'PrintSettingsNCopies'. +printSettingsNCopies :: PrintSettingsClass self => Attr self Int +printSettingsNCopies = newAttr + printSettingsGetNCopies + printSettingsSetNCopies + +-- | The value of 'PrintSettingsNumberUp'. +printSettingsNumberUp :: PrintSettingsClass self => Attr self Int +printSettingsNumberUp = newAttr + printSettingsGetNumberUp + printSettingsSetNumberUp + +-- | The value of 'PrintSettingsResolution'. +printSettingsResolution :: PrintSettingsClass self => Attr self Int +printSettingsResolution = newAttr + printSettingsGetResolution + printSettingsSetResolution + +-- | The value of 'PrintSettingsScale'. +printSettingsScale :: PrintSettingsClass self => Attr self Double +printSettingsScale = newAttr + printSettingsGetScale + printSettingsSetScale + +-- | The value of 'PrintSettingsPrintPages'. +printSettingsPrintPages :: PrintSettingsClass self => Attr self PrintPages +printSettingsPrintPages = newAttr + printSettingsGetPrintPages + printSettingsSetPrintPages + +-- | The value of 'PrintSettingsPageSet'. +printSettingsPageSet :: PrintSettingsClass self => Attr self PageSet +printSettingsPageSet = newAttr + printSettingsGetPageSet + printSettingsSetPageSet + +-- | The value of 'PrintSettingsDefaultSource'. +printSettingsDefaultSource :: PrintSettingsClass self => Attr self String +printSettingsDefaultSource = newAttr + printSettingsGetDefaultSource + printSettingsSetDefaultSource + +-- | The value of 'PrintSettingsMediaType'. +printSettingsMediaType :: PrintSettingsClass self => Attr self String +printSettingsMediaType = newAttr + printSettingsGetMediaType + printSettingsSetMediaType + +-- | The value of 'PrintSettingsDither'. +printSettingsDither :: PrintSettingsClass self => Attr self String +printSettingsDither = newAttr + printSettingsGetDither + printSettingsSetDither + +-- | The value of 'PrintSettingsFinishings'. +printSettingsFinishings :: PrintSettingsClass self => Attr self String +printSettingsFinishings = newAttr + printSettingsGetFinishings + printSettingsSetFinishings + +-- | The value of 'PrintSettingsOutputBin'. +printSettingsOutputBin :: PrintSettingsClass self => Attr self String +printSettingsOutputBin = newAttr + printSettingsGetOutputBin + printSettingsSetOutputBin + +#if GTK_CHECK_VERSION(2,14,0) +-- | The value of 'PrintSettingsNumberUpLayout'. +printSettingsNumberUpLayout :: PrintSettingsClass self => Attr self NumberUpLayout +printSettingsNumberUpLayout = newAttr + printSettingsGetNumberUpLayout + printSettingsSetNumberUpLayout +#endif + +#if GTK_CHECK_VERSION(2,16,0) +-- | The value of 'PrintSettingsPrinterLpi'. +printSettingsPrinterLpi :: PrintSettingsClass self => Attr self Double +printSettingsPrinterLpi = newAttr + printSettingsGetPrinterLpi + printSettingsSetPrinterLpi +#endif +#endif + diff --git a/Graphics/UI/Gtk/Recent/RecentChooser.chs b/Graphics/UI/Gtk/Recent/RecentChooser.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Recent/RecentChooser.chs @@ -0,0 +1,442 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Interface RecentChooser +-- +-- Author : Andy Stewart +-- +-- Created: 27 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- Interface implemented by widgets displaying recently used files +-- +-- * Module available since Gtk+ version 2.10 +-- +module Graphics.UI.Gtk.Recent.RecentChooser ( + +-- * Detail +-- +-- | 'RecentChooser' is an interface that can be implemented by widgets +-- displaying the list of recently used files. In Gtk+, the main objects that +-- implement this interface are 'RecentChooserWidget', 'RecentChooserDialog' +-- and 'RecentChooserMenu'. +-- +-- Recently used files are supported since Gtk+ 2.10. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GInterface' +-- | +----RecentChooser +-- @ + +#if GTK_CHECK_VERSION(2,10,0) +-- * Types + RecentChooser, + RecentChooserClass, + castToRecentChooser, + toRecentChooser, + +-- * Enums + RecentChooserError(..), + RecentSortType(..), + +-- * Methods + recentChooserSetSortFunc, + recentChooserSetCurrentURI, + recentChooserGetCurrentURI, + recentChooserGetCurrentItem, + recentChooserSelectURI, + recentChooserUnselectURI, + recentChooserSelectAll, + recentChooserUnselectAll, + recentChooserGetItems, + recentChooserGetURIs, + recentChooserAddFilter, + recentChooserRemoveFilter, + recentChooserListFilters, + +-- * Attributes + recentChooserShowPrivate, + recentChooserShowTips, + recentChooserShowIcons, + recentChooserShowNotFound, + recentChooserSelectMultiple, + recentChooserLocalOnly, + recentChooserLimit, + recentChooserSortType, + recentChooserFilter, + +-- * Signals + recentChooserSelectionChanged, + recentChooserItemActivated, +#endif + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.UTFString +import System.Glib.Attributes +import System.Glib.Properties +import System.Glib.GList +import System.Glib.GObject (Quark, quarkFromString) +import System.Glib.GError (GErrorDomain, GErrorClass(..), propagateGError, checkGError) +import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +{#import Graphics.UI.Gtk.Recent.RecentInfo#} (RecentInfo, mkRecentInfo) +{#import Graphics.UI.Gtk.Types#} +{#import Graphics.UI.Gtk.Signals#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,10,0) +-------------------- +-- Enums +-- | These identify the various errors that can occur while calling 'RecentChooser' functions. +{#enum RecentChooserError {underscoreToCase} deriving (Bounded,Eq,Show)#} + +-- | Used to specify the sorting method to be applyed to the recently used resource list. +{#enum RecentSortType {underscoreToCase} deriving (Bounded,Eq,Show)#} + +-------------------- +-- Methods + +-- | Sets the comparison function used when sorting to be @sortFunc@. If the +-- @chooser@ has the sort type set to 'RecentSortCustom' then the chooser will +-- sort using this function. +-- +-- To the comparison function will be passed two 'RecentInfo' structs and @sortData@; @sortFunc@ should return a positive +-- integer if the first item comes before the second, zero if the two items are +-- equal and a negative integer if the first item comes after the second. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserSetSortFunc :: RecentChooserClass self => self + -> (Maybe (RecentInfo -> IO Int)) + -> IO () +recentChooserSetSortFunc self Nothing = + {# call gtk_recent_chooser_set_sort_func #} + (toRecentChooser self) nullFunPtr nullPtr nullFunPtr +recentChooserSetSortFunc self (Just func) = do + fPtr <- mkRecentSortFunc $ \_ infoPtr _ -> do + info <- mkRecentInfo infoPtr + liftM fromIntegral (func info) + {# call gtk_recent_chooser_set_sort_func #} + (toRecentChooser self) + fPtr + (castFunPtrToPtr fPtr) + destroyFunPtr + +{#pointer RecentSortFunc#} + +foreign import ccall "wrapper" mkRecentSortFunc :: + (Ptr RecentInfo -> Ptr RecentInfo -> Ptr () -> IO {#type gint#}) + -> IO RecentSortFunc + +-- | Sets @uri@ as the current URI for @chooser@. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserSetCurrentURI :: RecentChooserClass self => self + -> String -- ^ @uri@ - a URI + -> IO Bool -- ^ returns @True@ if the URI was found. +recentChooserSetCurrentURI self uri = + checkGError ( \errorPtr -> + liftM toBool $ + withUTFString uri $ \uriPtr -> + {# call gtk_recent_chooser_set_current_uri #} + (toRecentChooser self) + uriPtr + errorPtr) + (\_ -> return False) + +-- | Gets the URI currently selected by @chooser@. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserGetCurrentURI :: RecentChooserClass self => self + -> IO String -- ^ returns a newly string holding a URI. +recentChooserGetCurrentURI self = + {# call gtk_recent_chooser_get_current_uri #} + (toRecentChooser self) + >>= readUTFString + +-- | Gets the 'RecentInfo' currently selected by +-- @chooser@. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserGetCurrentItem :: RecentChooserClass self => self + -> IO RecentInfo -- ^ returns a 'RecentInfo'. + -- Use 'recentInfoUnref' when when you have finished + -- using it. +recentChooserGetCurrentItem self = do + info <- {# call gtk_recent_chooser_get_current_item #} (toRecentChooser self) + mkRecentInfo info + +-- | Selects @uri@ inside @chooser@. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserSelectURI :: RecentChooserClass self => self + -> String -- ^ @uri@ - a URI + -> IO Bool -- ^ returns @True@ if @uri@ was found. +recentChooserSelectURI self uri = + checkGError ( \errorPtr -> + liftM toBool $ + withUTFString uri $ \uriPtr -> + {# call gtk_recent_chooser_select_uri #} + (toRecentChooser self) + uriPtr + errorPtr) + (\_ -> return False) + +-- | Unselects @uri@ inside @chooser@. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserUnselectURI :: RecentChooserClass self => self + -> String -- ^ @uri@ - a URI + -> IO () +recentChooserUnselectURI self uri = + withUTFString uri $ \uriPtr -> + {# call gtk_recent_chooser_unselect_uri #} + (toRecentChooser self) + uriPtr + +-- | Selects all the items inside @chooser@, if the @chooser@ supports +-- multiple selection. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserSelectAll :: RecentChooserClass self => self -> IO () +recentChooserSelectAll self = + {# call gtk_recent_chooser_select_all #} + (toRecentChooser self) + +-- | Unselects all the items inside @chooser@. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserUnselectAll :: RecentChooserClass self => self -> IO () +recentChooserUnselectAll self = + {# call gtk_recent_chooser_unselect_all #} + (toRecentChooser self) + +-- | Gets the list of recently used resources in form of 'RecentInfo' +-- +-- The return value of this function is affected by the \"sort-type\" and +-- \"limit\" properties of @chooser@. +-- +recentChooserGetItems :: RecentChooserClass self => self + -> IO [RecentInfo] -- ^ returns A list of 'RecentInfo' objects. +recentChooserGetItems self = do + glist <- {# call gtk_recent_chooser_get_items #} (toRecentChooser self) + list <- fromGList glist + mapM mkRecentInfo list + +-- | Gets the URI of the recently used resources. +-- +-- The return value of this function is affected by the \"sort-type\" and +-- \"limit\" properties of @chooser@. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserGetURIs :: RecentChooserClass self => self + -> IO [String] +recentChooserGetURIs self = + alloca $ \lengthPtr -> do + str <- {# call gtk_recent_chooser_get_uris #} + (toRecentChooser self) + lengthPtr + length <- peek lengthPtr + mapM peekUTFString =<< peekArray (fromIntegral length) str + +-- | Adds @filter@ to the list of 'RecentFilter' objects held by @chooser@. +-- +-- If no previous filter objects were defined, this function will call +-- 'recentChooserSetFilter'. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserAddFilter :: (RecentChooserClass self, RecentFilterClass filter) => self + -> filter -- ^ @filter@ - a 'RecentFilter' + -> IO () +recentChooserAddFilter self filter = + {# call gtk_recent_chooser_add_filter #} + (toRecentChooser self) + (toRecentFilter filter) + +-- | Removes @filter@ from the list of 'RecentFilter' objects held by +-- @chooser@. +-- +recentChooserRemoveFilter :: (RecentChooserClass self, RecentFilterClass filter) => self + -> filter -- ^ @filter@ - a 'RecentFilter' + -> IO () +recentChooserRemoveFilter self filter = + {# call gtk_recent_chooser_remove_filter #} + (toRecentChooser self) + (toRecentFilter filter) + +-- | Gets the 'RecentFilter' objects held by @chooser@. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserListFilters :: RecentChooserClass self => self + -> IO [RecentFilter] -- ^ returns A singly linked list of 'RecentFilter'. +recentChooserListFilters self = do + glist <- {# call gtk_recent_chooser_list_filters #} + (toRecentChooser self) + list <- fromGList glist + mapM (\x -> makeNewObject mkRecentFilter (return (castPtr x))) list + +-------------------- +-- Attributes + +-- | Whether the private items should be displayed. +-- +-- Default value: 'False' +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserShowPrivate :: RecentChooserClass self => Attr self Bool +recentChooserShowPrivate = newAttrFromBoolProperty "show-private" + +-- | Whether this 'RecentChooser' should display a tooltip containing the full path of the recently used +-- resources. +-- +-- Default value: 'False' +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserShowTips :: RecentChooserClass self => Attr self Bool +recentChooserShowTips = newAttrFromBoolProperty "show-tips" + +-- | Whether this 'RecentChooser' should display an icon near the item. +-- +-- Default value: 'True' +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserShowIcons :: RecentChooserClass self => Attr self Bool +recentChooserShowIcons = newAttrFromBoolProperty "show-icons" + +-- | Whether this 'RecentChooser' should display the recently used resources even if not present +-- anymore. Setting this to 'False' will perform a potentially expensive check on every local resource +-- (every remote resource will always be displayed). +-- +-- Default value: 'True' +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserShowNotFound :: RecentChooserClass self => Attr self Bool +recentChooserShowNotFound = newAttrFromBoolProperty "show-not-found" + +-- | Allow the user to select multiple resources. +-- +-- Default value: 'False' +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserSelectMultiple :: RecentChooserClass self => Attr self Bool +recentChooserSelectMultiple = newAttrFromBoolProperty "select-multiple" + +-- | Whether this 'RecentChooser' should display only local (file:) resources. +-- +-- Default value: 'True' +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserLocalOnly :: RecentChooserClass self => Attr self Bool +recentChooserLocalOnly = newAttrFromBoolProperty "local-only" + +-- | The maximum number of recently used resources to be displayed, or -1 to display all items. By +-- default, the 'Setting':gtk-recent-files-limit setting is respected: you can override that limit on +-- a particular instance of 'RecentChooser' by setting this property. +-- +-- Allowed values: >= 'GMaxulong' +-- +-- Default value: -1 +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserLimit :: RecentChooserClass self => Attr self Int +recentChooserLimit = newAttrFromIntProperty "limit" + +-- | Sorting order to be used when displaying the recently used resources. +-- +-- Default value: ''RecentSortNone'' +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserSortType :: RecentChooserClass self => Attr self RecentSortType +recentChooserSortType = newAttrFromEnumProperty "sort-type" + {# call pure unsafe gtk_recent_sort_type_get_type #} + +-- | The 'RecentFilter' object to be used when displaying the recently used resources. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserFilter :: (RecentChooserClass self, RecentFilterClass recentFilter) => ReadWriteAttr self RecentFilter recentFilter +recentChooserFilter = newAttrFromObjectProperty "filter" + {# call pure unsafe gtk_recent_filter_get_type #} + +-------------------- +-- Signals + +-- | This signal is emitted when there is a change in the set of selected +-- recently used resources. This can happen when a user modifies the selection +-- with the mouse or the keyboard, or when explicitely calling functions to +-- change the selection. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserSelectionChanged :: RecentChooserClass self => Signal self (IO ()) +recentChooserSelectionChanged = Signal (connect_NONE__NONE "selection_changed") + +-- | This signal is emitted when the user \"activates\" a recent item in the +-- recent chooser. This can happen by double-clicking on an item in the +-- recently used resources list, or by pressing Enter. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserItemActivated :: RecentChooserClass self => Signal self (IO ()) +recentChooserItemActivated = Signal (connect_NONE__NONE "item_activated") +#endif diff --git a/Graphics/UI/Gtk/Recent/RecentChooserMenu.chs b/Graphics/UI/Gtk/Recent/RecentChooserMenu.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Recent/RecentChooserMenu.chs @@ -0,0 +1,149 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget RecentChooserMenu +-- +-- Author : Andy Stewart +-- +-- Created: 27 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- Displays recently used files in a menu +-- +-- * Module available since Gtk+ version 2.10 +-- +module Graphics.UI.Gtk.Recent.RecentChooserMenu ( + +-- * Detail +-- +-- | 'RecentChooserMenu' is a widget suitable for displaying recently used +-- files inside a menu. It can be used to set a sub-menu of a 'MenuItem' using +-- 'menuItemSetSubmenu', or as the menu of a 'MenuToolButton'. +-- +-- Note that 'RecentChooserMenu' does not have any methods of its own. +-- Instead, you should use the functions that work on a 'RecentChooser'. +-- +-- Note also that 'RecentChooserMenu' does not support multiple filters, as +-- it has no way to let the user choose between them as the +-- 'RecentChooserWidget' and 'RecentChooserDialog' widgets do. Thus using +-- 'recentChooserAddFilter' on a 'RecentChooserMenu' widget will yield the same +-- effects as using 'recentChooserSetFilter', replacing any currently set +-- filter with the supplied filter; 'recentChooserRemoveFilter' will remove any +-- currently set 'RecentFilter' object and will unset the current filter; +-- 'recentChooserListFilters' will return a list containing a single +-- 'RecentFilter' object. +-- +-- Recently used files are supported since Gtk+ 2.10. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----'Widget' +-- | +----'Container' +-- | +----'MenuShell' +-- | +----'Menu' +-- | +----RecentChooserMenu +-- @ + +#if GTK_CHECK_VERSION(2,10,0) +-- * Types + RecentChooserMenu, + RecentChooserMenuClass, + castToRecentChooserMenu, + toRecentChooserMenu, + +-- * Constructors + recentChooserMenuNew, + recentChooserMenuNewForManager, + +-- * Attributes + recentChooserMenuShowNumbers, +#endif + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.Attributes +import System.Glib.Properties +import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +{#import Graphics.UI.Gtk.Types#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,10,0) + +-------------------- +-- Constructors + +-- | Creates a new 'RecentChooserMenu' widget. +-- +-- This kind of widget shows the list of recently used resources as a menu, +-- each item as a menu item. Each item inside the menu might have an icon, +-- representing its MIME type, and a number, for mnemonic access. +-- +-- This widget implements the 'RecentChooser' interface. +-- +-- This widget creates its own 'RecentManager' object. See the +-- 'recentChooserMenuNewForManager' function to know how to create a +-- 'RecentChooserMenu' widget bound to another 'RecentManager' object. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserMenuNew :: IO RecentChooserMenu +recentChooserMenuNew = + makeNewObject mkRecentChooserMenu $ + liftM (castPtr :: Ptr Widget -> Ptr RecentChooserMenu) $ + {# call gtk_recent_chooser_menu_new #} + +-- | Creates a new 'RecentChooserMenu' widget using @manager@ as the +-- underlying recently used resources manager. +-- +-- This is useful if you have implemented your own recent manager, or if you +-- have a customized instance of a 'RecentManager' object or if you wish to +-- share a common 'RecentManager' object among multiple 'RecentChooser' +-- widgets. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserMenuNewForManager :: RecentManagerClass manager + => manager -- ^ @manager@ - a 'RecentManager' + -> IO RecentChooserMenu -- ^ returns a new 'RecentChooserMenu', bound to manager. +recentChooserMenuNewForManager manager = + makeNewObject mkRecentChooserMenu $ + liftM (castPtr :: Ptr Widget -> Ptr RecentChooserMenu) $ + {# call gtk_recent_chooser_menu_new_for_manager #} + (toRecentManager manager) + +-------------------- +-- Attributes + +-- | Whether the first ten items in the menu should be prepended by a number acting as a unique mnemonic. +-- +-- Default value: 'False' +-- +-- * Available since Gtk+ version 2.10 +-- +recentChooserMenuShowNumbers :: RecentChooserMenuClass self => Attr self Bool +recentChooserMenuShowNumbers = newAttrFromBoolProperty "show-numbers" +#endif diff --git a/Graphics/UI/Gtk/Recent/RecentChooserWidget.chs b/Graphics/UI/Gtk/Recent/RecentChooserWidget.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Recent/RecentChooserWidget.chs @@ -0,0 +1,107 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget RecentChooserWidget +-- +-- Author : Andy Stewart +-- +-- Created: 27 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- Displays recently used files +-- +-- * Module available since Gtk+ version 2.10 +-- +module Graphics.UI.Gtk.Recent.RecentChooserWidget ( + +-- * Detail +-- +-- | 'RecentChooserWidget' is a widget suitable for selecting recently used +-- files. It is the main building block of a 'RecentChooserDialog'. Most +-- applications will only need to use the latter; you can use +-- 'RecentChooserWidget' as part of a larger window if you have special needs. +-- +-- Note that 'RecentChooserWidget' does not have any methods of its own. +-- Instead, you should use the functions that work on a 'RecentChooser'. +-- +-- Recently used files are supported since Gtk+ 2.10. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----'Widget' +-- | +----'Container' +-- | +----'Box' +-- | +----'VBox' +-- | +----RecentChooserWidget +-- @ + +#if GTK_CHECK_VERSION(2,10,0) +-- * Types + RecentChooserWidget, + RecentChooserWidgetClass, + castToRecentChooserWidget, + toRecentChooserWidget, + +-- * Constructors + recentChooserWidgetNew, + recentChooserWidgetNewForManager, +#endif + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.Attributes +import System.Glib.Properties +{#import Graphics.UI.Gtk.Types#} +import Graphics.UI.Gtk.Abstract.Object (makeNewObject) + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,10,0) + +-------------------- +-- Constructors + +-- | Creates a new 'RecentChooserWidget' object. This is an embeddable widget +-- used to access the recently used resources list. +-- +recentChooserWidgetNew :: IO RecentChooserWidget +recentChooserWidgetNew = + makeNewObject mkRecentChooserWidget $ + liftM (castPtr :: Ptr Widget -> Ptr RecentChooserWidget) $ + {# call gtk_recent_chooser_widget_new #} + +-- | Creates a new 'RecentChooserWidget' with a specified recent manager. +-- +-- This is useful if you have implemented your own recent manager, or if you +-- have a customized instance of a 'RecentManager' object. +-- +recentChooserWidgetNewForManager :: RecentManagerClass manager + => manager -- ^ @manager@ - a 'RecentManager' + -> IO RecentChooserWidget -- ^ returns a new 'RecentChooserWidget' +recentChooserWidgetNewForManager manager = + makeNewObject mkRecentChooserWidget $ + liftM (castPtr :: Ptr Widget -> Ptr RecentChooserWidget) $ + {# call gtk_recent_chooser_widget_new_for_manager #} + (toRecentManager manager) +#endif diff --git a/Graphics/UI/Gtk/Recent/RecentFilter.chs b/Graphics/UI/Gtk/Recent/RecentFilter.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Recent/RecentFilter.chs @@ -0,0 +1,225 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget RecentFilter +-- +-- Author : Andy Stewart +-- +-- Created: 27 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- A filter for selecting a subset of recently used files +-- +-- * Module available since Gtk+ version 2.10 +-- +module Graphics.UI.Gtk.Recent.RecentFilter ( + +-- * Detail +-- +-- | A 'RecentFilter' can be used to restrict the files being shown in a +-- 'RecentChooser'. Files can be filtered based on their name (with +-- 'recentFilterAddPattern'), on their mime type (with +-- 'fileFilterAddMimeType'), on the application that has registered them (with +-- 'recentFilterAddApplication'), or by a custom filter function (with +-- 'recentFilterAddCustom'). +-- +-- Filtering by mime type handles aliasing and subclassing of mime types; +-- e.g. a filter for text\/plain also matches a file with mime type +-- application\/rtf, since application\/rtf is a subclass of text\/plain. Note +-- that 'RecentFilter' allows wildcards for the subtype of a mime type, so you +-- can e.g. filter for image\/. +-- +-- Normally, filters are used by adding them to a 'RecentChooser', see +-- 'recentChooserAddFilter', but it is also possible to manually use a filter +-- on a file with 'recentFilterFilter'. +-- +-- Recently used files are supported since Gtk+ 2.10. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----RecentFilter +-- @ + +#if GTK_CHECK_VERSION(2,10,0) +-- * Types + RecentFilter, + RecentFilterClass, + castToRecentFilter, + toRecentFilter, + +-- * Enums + RecentFilterFlags(..), + +-- * Constructors + recentFilterNew, + +-- * Methods + recentFilterGetName, + recentFilterSetName, + recentFilterAddMimeType, + recentFilterAddPattern, + recentFilterAddPixbufFormats, + recentFilterAddApplication, + recentFilterAddGroup, + recentFilterAddAge, +#endif + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.UTFString +import System.Glib.Flags (Flags, toFlags, fromFlags) +import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +{#import Graphics.UI.Gtk.Types#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,10,0) +--------------------- +-- Enums +-- | These flags indicate what parts of a 'RecentFilterInfo' struct are filled or need to be filled. +{#enum RecentFilterFlags {underscoreToCase} deriving (Bounded,Eq,Show)#} + +-------------------- +-- Constructors + +-- | Creates a new 'RecentFilter' with no rules added to it. Such filter does +-- not accept any recently used resources, so is not particularly useful until +-- you add rules with 'recentFilterAddPattern', 'recentFilterAddMimeType', +-- 'recentFilterAddApplication', 'recentFilterAddAge'. To create a filter that +-- accepts any recently used resource, use: +-- +-- > filter <- recentFilterNew +-- > recentFilterAddPattern filter "*" +-- +-- * Available since Gtk+ version 2.10 +-- +recentFilterNew :: IO RecentFilter +recentFilterNew = + makeNewObject mkRecentFilter $ + {# call gtk_recent_filter_new #} + +-------------------- +-- Methods +-- | Gets the human-readable name for the filter. See 'recentFilterSetName'. +-- +-- * Available since Gtk+ version 2.10 +-- +recentFilterGetName :: RecentFilterClass self => self + -> IO String -- ^ returns the name of the filter +recentFilterGetName self = + {# call gtk_recent_filter_get_name #} + (toRecentFilter self) + >>= peekUTFString + +-- | Sets the human-readable name of the filter; this is the string that will be displayed in the +-- recently used resources selector user interface if there is a selectable list of filters. +-- +-- * Available since Gtk+ version 2.10 +-- +recentFilterSetName :: RecentFilterClass self => self + -> String -- ^ @name@ - then human readable name of @filter@ + -> IO () +recentFilterSetName self name = + withUTFString name $ \namePtr -> + {# call gtk_recent_filter_set_name #} + (toRecentFilter self) + namePtr + +-- | Adds a rule that allows resources based on their registered MIME type. +-- +-- * Available since Gtk+ version 2.10 +-- +recentFilterAddMimeType :: RecentFilterClass self => self + -> String -- ^ @mimeType@ - a MIME type + -> IO () +recentFilterAddMimeType self mimeType = + withUTFString mimeType $ \mimeTypePtr -> + {# call gtk_recent_filter_add_mime_type #} + (toRecentFilter self) + mimeTypePtr + +-- | Adds a rule that allows resources based on a pattern matching their +-- display name. +-- +-- * Available since Gtk+ version 2.10 +-- +recentFilterAddPattern :: RecentFilterClass self => self + -> String -- ^ @pattern@ - a file pattern + -> IO () +recentFilterAddPattern self pattern = + withUTFString pattern $ \patternPtr -> + {# call gtk_recent_filter_add_pattern #} + (toRecentFilter self) + patternPtr + +-- | Adds a rule allowing image files in the formats supported by 'Pixbuf'. +-- +recentFilterAddPixbufFormats :: RecentFilterClass self => self -> IO () +recentFilterAddPixbufFormats self = + {# call gtk_recent_filter_add_pixbuf_formats #} + (toRecentFilter self) + +-- | Adds a rule that allows resources based on the name of the application +-- that has registered them. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentFilterAddApplication :: RecentFilterClass self => self + -> String -- ^ @application@ - an application name + -> IO () +recentFilterAddApplication self application = + withUTFString application $ \applicationPtr -> + {# call gtk_recent_filter_add_application #} + (toRecentFilter self) + applicationPtr + +-- | Adds a rule that allows resources based on the name of the group to which +-- they belong +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentFilterAddGroup :: RecentFilterClass self => self + -> String -- ^ @group@ - a group name + -> IO () +recentFilterAddGroup self group = + withUTFString group $ \groupPtr -> + {# call gtk_recent_filter_add_group #} + (toRecentFilter self) + groupPtr + +-- | Adds a rule that allows resources based on their age - that is, the +-- number of days elapsed since they were last modified. +-- +-- * Available since Gtk+ version 2.10 +-- +recentFilterAddAge :: RecentFilterClass self => self + -> Int -- ^ @days@ - number of days + -> IO () +recentFilterAddAge self days = + {# call gtk_recent_filter_add_age #} + (toRecentFilter self) + (fromIntegral days) +#endif diff --git a/Graphics/UI/Gtk/Recent/RecentInfo.chs b/Graphics/UI/Gtk/Recent/RecentInfo.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Recent/RecentInfo.chs @@ -0,0 +1,352 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget RecentInfo +-- +-- Author : Andy Stewart +-- +-- Created: 27 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- +module Graphics.UI.Gtk.Recent.RecentInfo ( + +#if GTK_CHECK_VERSION(2,10,0) +-- * Types + RecentInfo, + mkRecentInfo, + +-- * Methods + recentInfoExists, + recentInfoGetAdded, + recentInfoGetAge, + recentInfoGetApplicationInfo, + recentInfoGetApplications, + recentInfoGetDescription, + recentInfoGetDisplayName, + recentInfoGetGroups, + recentInfoGetIcon, + recentInfoGetMimeType, + recentInfoGetModified, + recentInfoGetPrivateHint, + recentInfoGetShortName, + recentInfoGetURI, + recentInfoGetURIDisplay, + recentInfoGetVisited, + recentInfoHasApplication, + recentInfoHasGroup, + recentInfoIsLocal, + recentInfoLastApplication, + recentInfoMatch, +#endif + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.Attributes +import System.Glib.Properties +import System.Glib.UTFString +{#import Graphics.UI.Gtk.Types#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,10,0) +-------------------- +-- Types +{#pointer *RecentInfo foreign newtype#} + +-------------------- +-- Methods + +-- | Helper function for build 'RecentInfo' +mkRecentInfo :: Ptr RecentInfo -> IO RecentInfo +mkRecentInfo rPtr = do + info <- newForeignPtr rPtr gtk_recent_info_unref + return (RecentInfo info) + +foreign import ccall unsafe ">k_recent_info_unref" + gtk_recent_info_unref :: FinalizerPtr RecentInfo + +-- | Checks whether the resource pointed by info still exists. At the moment this check is done only on +-- resources pointing to local files. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoExists :: RecentInfo + -> IO Bool -- ^ returns 'True' if the resource exists +recentInfoExists self = + liftM toBool $ + {# call gtk_recent_info_exists #} + self + +-- | Gets the timestamp (seconds from system's Epoch) when the resource was added to the recently used +-- resources list. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoGetAdded :: RecentInfo + -> IO Int -- ^ returns the number of seconds elapsed from system's Epoch when the resource was added to the list, or -1 on failure. +recentInfoGetAdded self = + liftM fromIntegral $ + {# call gtk_recent_info_get_added #} + self + +-- | Gets the number of days elapsed since the last update of the resource pointed by info. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoGetAge :: RecentInfo + -> IO Int -- ^ returns a positive integer containing the number of days elapsed since the time this resource was last modified. +recentInfoGetAge self = + liftM fromIntegral $ + {# call gtk_recent_info_get_age #} + self + +-- | Gets the data regarding the application that has registered the resource pointed by info. +-- +-- If the command line contains any escape characters defined inside the storage specification, they +-- will be expanded. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoGetApplicationInfo :: RecentInfo + -> String -- ^ @appName@ the name of the application that has registered this item + -> IO (Maybe ([String], Int, Int)) + -- ^ @appExec@ return location for the string containing the command line. transfer none. + -- ^ @count@ return location for the number of times this item was registered. out. + -- ^ @time@ out. out. +recentInfoGetApplicationInfo self appName = + alloca $ \countPtr -> + alloca $ \timePtr -> + allocaArray 0 $ \execPtr -> + withUTFString appName $ \appNamePtr -> do + success <- liftM toBool $ + {# call gtk_recent_info_get_application_info #} + self + appNamePtr + execPtr + countPtr + timePtr + if success + then do + exec <- mapM peekUTFString =<< peekArray 0 execPtr + count <- peek countPtr + time <- peek timePtr + return (Just (exec, fromIntegral count, fromIntegral time)) + else return Nothing + +-- | Retrieves the list of applications that have registered this resource. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoGetApplications :: RecentInfo -> IO [String] +recentInfoGetApplications self = + alloca $ \lengthPtr -> do + str <- {# call gtk_recent_info_get_applications #} self lengthPtr + length <- peek lengthPtr + mapM peekUTFString =<< peekArray (fromIntegral length) str + +-- | Gets the (short) description of the resource. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoGetDescription :: RecentInfo + -> IO String -- ^ returns the description of the resource. +recentInfoGetDescription self = + {# call gtk_recent_info_get_description #} + self + >>= peekUTFString + +-- | Gets the name of the resource. If none has been defined, the basename of the resource is obtained. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoGetDisplayName :: RecentInfo + -> IO String -- ^ returns the display name of the resource. +recentInfoGetDisplayName self = + {# call gtk_recent_info_get_display_name #} + self + >>= peekUTFString + +-- | Returns all groups registered for the recently used item info. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoGetGroups :: RecentInfo -> IO [String] +recentInfoGetGroups self = + alloca $ \lengthPtr -> do + str <- {# call gtk_recent_info_get_groups #} self lengthPtr + length <- peek lengthPtr + mapM peekUTFString =<< peekArray (fromIntegral length) str + +-- | Retrieves the icon of size size associated to the resource MIME type. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoGetIcon :: RecentInfo + -> Int -- ^ @size@ the size of the icon in pixels + -> IO (Maybe Pixbuf) -- ^ returns a 'Pixbuf' containing the icon, or 'Nothing' +recentInfoGetIcon self size = + maybeNull (makeNewGObject mkPixbuf) $ + {# call gtk_recent_info_get_icon #} + self + (fromIntegral size) + +-- | Gets the MIME type of the resource. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoGetMimeType :: RecentInfo + -> IO String -- ^ returns the MIME type of the resource. +recentInfoGetMimeType self = + {# call gtk_recent_info_get_mime_type #} + self + >>= peekUTFString + +-- | Gets the timestamp (seconds from system's Epoch) when the resource was last modified. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoGetModified :: RecentInfo + -> IO Int -- ^ returns the number of seconds elapsed from system's Epoch when the resource was last modified, or -1 on failure. +recentInfoGetModified self = + liftM fromIntegral $ + {# call gtk_recent_info_get_modified #} + self + +-- | Gets the value of the "private" flag. Resources in the recently used list that have this flag set to +-- 'True' should only be displayed by the applications that have registered them. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoGetPrivateHint :: RecentInfo + -> IO Bool -- ^ returns 'True' if the private flag was found, 'False' otherwise. +recentInfoGetPrivateHint self = + liftM toBool $ + {# call gtk_recent_info_get_private_hint #} + self + +-- | Computes a valid UTF-8 string that can be used as the name of the item in a menu or list. For +-- example, calling this function on an item that refers to \"file:///foo/bar.txt\" will yield \"bar.txt\". +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoGetShortName :: RecentInfo + -> IO String +recentInfoGetShortName self = + {# call gtk_recent_info_get_short_name #} + self + >>= readUTFString + +-- | Gets the URI of the resource. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoGetURI :: RecentInfo + -> IO String -- ^ returns the URI of the resource. +recentInfoGetURI self = + {# call gtk_recent_info_get_uri #} + self + >>= peekUTFString + +-- | Gets a displayable version of the resource's URI. If the resource is local, it returns a local path; +-- if the resource is not local, it returns the UTF-8 encoded content of 'recentInfoGetUri'. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoGetURIDisplay :: RecentInfo -> IO String +recentInfoGetURIDisplay self = + {# call gtk_recent_info_get_uri_display #} + self + >>= readUTFString + +-- | Gets the timestamp (seconds from system's Epoch) when the resource was last visited. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoGetVisited :: RecentInfo + -> IO Int -- ^ returns the number of seconds elapsed from system's Epoch when the resource was last visited, or -1 on failure. +recentInfoGetVisited self = + liftM fromIntegral $ + {# call gtk_recent_info_get_visited #} + self + +-- | Checks whether an application registered this resource using @appName@. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoHasApplication :: RecentInfo + -> String -- ^ @appName@ a string containing an application name + -> IO Bool -- ^ returns 'True' if an application with name @appName@ was found, 'False' otherwise. +recentInfoHasApplication self appName = + liftM toBool $ + withUTFString appName $ \appNamePtr -> + {# call gtk_recent_info_has_application #} + self + appNamePtr + +-- | Checks whether @groupName@ appears inside the groups registered for the recently used item info. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoHasGroup :: RecentInfo + -> String -- ^ @groupName@ name of a group + -> IO Bool -- ^ returns 'True' if the group was found. +recentInfoHasGroup self groupName = + liftM toBool $ + withUTFString groupName $ \groupNamePtr -> + {# call gtk_recent_info_has_group #} + self + groupNamePtr + +-- | Checks whether the resource is local or not by looking at the scheme of its URI. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoIsLocal :: RecentInfo + -> IO Bool -- ^ returns 'True' if the resource is local. +recentInfoIsLocal self = + liftM toBool $ + {# call gtk_recent_info_is_local #} + self + +-- | Gets the name of the last application that have registered the recently used resource represented by +-- info. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoLastApplication :: RecentInfo + -> IO String -- ^ returns an application name. +recentInfoLastApplication self = + {# call gtk_recent_info_last_application #} + self + >>= readUTFString + +-- | Checks whether two 'RecentInfo' structures point to the same resource. +-- +-- * Available since Gtk+ version 2.10 +-- +recentInfoMatch :: RecentInfo -> RecentInfo + -> IO Bool -- ^ returns 'True' if both 'RecentInfo' structures point to se same resource, 'False' otherwise. +recentInfoMatch self infoB = + liftM toBool $ + {# call gtk_recent_info_match #} + self + infoB +#endif diff --git a/Graphics/UI/Gtk/Recent/RecentManager.chs b/Graphics/UI/Gtk/Recent/RecentManager.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Recent/RecentManager.chs @@ -0,0 +1,321 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget RecentManager +-- +-- Author : Andy Stewart +-- +-- Created: 27 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- Managing Recently Used Files +-- +-- * Module available since Gtk+ version 2.10 +-- +-- TODO: +-- GtkRecentData +-- gtk_recent_manager_add_full +-- +module Graphics.UI.Gtk.Recent.RecentManager ( + +-- * Detail +-- +-- | 'RecentManager' provides a facility for adding, removing and looking up +-- recently used files. Each recently used file is identified by its URI, and +-- has meta-data associated to it, like the names and command lines of the +-- applications that have registered it, the number of time each application +-- has registered the same file, the mime type of the file and whether the file +-- should be displayed only by the applications that have registered it. +-- +-- The 'RecentManager' acts like a database of all the recently used files. +-- You can create new 'RecentManager' objects, but it is more efficient to use +-- the standard recent manager for the 'Screen' so that informations about the +-- recently used files is shared with other people using them. In case the +-- default screen is being used, adding a new recently used file is as simple +-- as: +-- +-- Recently used files are supported since Gtk+ 2.10. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----RecentManager +-- @ + +#if GTK_CHECK_VERSION(2,10,0) +-- * Types + RecentManager, + RecentManagerClass, + castToRecentManager, + toRecentManager, + +-- * Constructors + recentManagerNew, + +-- * Methods + recentManagerGetDefault, + recentManagerAddItem, + recentManagerRemoveItem, + recentManagerLookupItem, + recentManagerHasItem, + recentManagerMoveItem, + recentManagerGetItems, + recentManagerPurgeItems, + +-- * Attributes + recentManagerFilename, + recentManagerLimit, + recentManagerSize, + +-- * Signals + recentManagerChanged, +#endif + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.Attributes +import System.Glib.Properties +import System.Glib.GList +import System.Glib.UTFString +import System.Glib.GObject (Quark, quarkFromString) +import System.Glib.GError (GErrorDomain, GErrorClass(..), propagateGError, checkGError) +{#import Graphics.UI.Gtk.Recent.RecentInfo#} (RecentInfo, mkRecentInfo) +{#import Graphics.UI.Gtk.Types#} +{#import Graphics.UI.Gtk.Signals#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,10,0) + +-------------------- +-- Constructors + +-- | Creates a new recent manager object. Recent manager objects are used to +-- handle the list of recently used resources. A 'RecentManager' object +-- monitors the recently used resources list, and emits the \"changed\" signal +-- each time something inside the list changes. +-- +-- * Available since Gtk+ version 2.10 +-- +recentManagerNew :: IO RecentManager +recentManagerNew = + wrapNewGObject mkRecentManager $ + {# call gtk_recent_manager_new #} + +-------------------- +-- Methods + +-- | Gets a unique instance of 'RecentManager'. +-- +-- * Available since Gtk+ version 2.10 +-- +recentManagerGetDefault :: IO RecentManager -- ^ returns A unique 'RecentManager'. +recentManagerGetDefault = + makeNewGObject mkRecentManager $ + {# call gtk_recent_manager_get_default #} + +-- | Adds a new resource, pointed by @uri@, into the recently used resources +-- list. +-- +-- This function automatically retrieves some of the needed metadata and +-- setting other metadata to common default values; it then feeds the data to +-- 'recentManagerAddFull'. +-- +-- See 'recentManagerAddFull' if you want to explicitly define the metadata +-- for the resource pointed by @uri@. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentManagerAddItem :: RecentManagerClass self => self + -> String -- ^ @uri@ - a valid URI + -> IO Bool -- ^ returns @True@ if the new item was successfully added to the + -- recently used resources list +recentManagerAddItem self uri = + liftM toBool $ + withUTFString uri $ \uriPtr -> + {# call gtk_recent_manager_add_item #} + (toRecentManager self) + uriPtr + +-- | Removes a resource pointed by @uri@ from the recently used resources list +-- handled by a recent manager. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentManagerRemoveItem :: RecentManagerClass self => self + -> String -- ^ @uri@ - the URI of the item you wish to remove + -> IO Bool -- ^ returns @True@ if the item pointed by @uri@ has been + -- successfully removed by the recently used resources list, and + -- @False@ otherwise. +recentManagerRemoveItem self uri = + checkGError (\errorPtr -> + liftM toBool $ + withUTFString uri $ \uriPtr -> + {# call gtk_recent_manager_remove_item #} + (toRecentManager self) + uriPtr + errorPtr) + (\_ -> return False) + +-- | Searches for a URI inside the recently used resources list, and returns a +-- structure containing informations about the resource like its MIME type, or +-- its display name. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentManagerLookupItem :: RecentManagerClass self => self + -> String -- ^ @uri@ - a URI + -> IO RecentInfo -- ^ returns a 'RecentInfo' + -- structure containing information about the + -- resource pointed by @uri@, or {@NULL@, FIXME: this + -- should probably be converted to a Maybe data type} + -- if the URI was not registered in the recently used + -- resources list. +recentManagerLookupItem self uri = + propagateGError $ \errorPtr -> + withUTFString uri $ \uriPtr -> do + result <- {# call unsafe gtk_recent_manager_lookup_item #} + (toRecentManager self) + uriPtr + errorPtr + mkRecentInfo result + +-- | Checks whether there is a recently used resource registered with @uri@ +-- inside the recent manager. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentManagerHasItem :: RecentManagerClass self => self + -> String -- ^ @uri@ - a URI + -> IO Bool -- ^ returns @True@ if the resource was found, @False@ otherwise. +recentManagerHasItem self uri = + liftM toBool $ + withUTFString uri $ \uriPtr -> + {# call gtk_recent_manager_has_item #} + (toRecentManager self) + uriPtr + +-- | Changes the location of a recently used resource from @uri@ to @newUri@. +-- +-- Please note that this function will not affect the resource pointed by +-- the URIs, but only the URI used in the recently used resources list. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentManagerMoveItem :: RecentManagerClass self => self + -> String -- ^ @uri@ - the URI of a recently used resource + -> String -- ^ @newUri@ - the new URI of the recently used resource to remove the item pointed by @uri@ in the list + -> IO Bool -- ^ returns @True@ on success. +recentManagerMoveItem self uri newUri = + checkGError ( \errorPtr -> + liftM toBool $ + withUTFString newUri $ \newUriPtr -> + withUTFString uri $ \uriPtr -> + {# call gtk_recent_manager_move_item #} + (toRecentManager self) + uriPtr + newUriPtr + errorPtr) + (\_ -> return False) + +-- | Gets the list of recently used resources. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentManagerGetItems :: RecentManagerClass self => self + -> IO [RecentInfo] -- ^ returns a list of newly allocated + -- 'RecentInfo' objects. +recentManagerGetItems self = do + glist <- {# call gtk_recent_manager_get_items #} + (toRecentManager self) + list <- fromGList glist + mapM mkRecentInfo list + +-- | Purges every item from the recently used resources list. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentManagerPurgeItems :: RecentManagerClass self => self + -> IO Int -- ^ returns the number of items that have been removed from the + -- recently used resources list. +recentManagerPurgeItems self = + liftM fromIntegral $ + propagateGError $ \errorPtr -> + {# call gtk_recent_manager_purge_items #} + (toRecentManager self) + errorPtr + +-------------------- +-- Attributes + +-- | The full path to the file to be used to store and read the recently used resources list +-- +-- Default value: 'Nothing' +-- +-- * Available since Gtk+ version 2.10 +-- +recentManagerFilename :: RecentManagerClass self => ReadAttr self String +recentManagerFilename = readAttrFromStringProperty "filename" + +-- | The maximum number of items to be returned by the 'recentManagerGetItems' function. +-- +-- Allowed values: >= 'GMaxulong' +-- +-- Default value: -1 +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentManagerLimit :: RecentManagerClass self => Attr self Int +recentManagerLimit = newAttrFromIntProperty "limit" + +-- | The size of the recently used resources list. +-- +-- Allowed values: >= 'GMaxulong' +-- +-- Default value: 0 +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentManagerSize :: RecentManagerClass self => ReadAttr self Int +recentManagerSize = readAttrFromIntProperty "size" + +-------------------- +-- Signals + +-- | Emitted when the current recently used resources manager changes its +-- contents. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +recentManagerChanged :: RecentManagerClass self => Signal self (IO ()) +recentManagerChanged = Signal (connect_NONE__NONE "changed") +#endif diff --git a/Graphics/UI/Gtk/Scrolling/HScrollbar.chs b/Graphics/UI/Gtk/Scrolling/HScrollbar.chs --- a/Graphics/UI/Gtk/Scrolling/HScrollbar.chs +++ b/Graphics/UI/Gtk/Scrolling/HScrollbar.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget HScrollbar -- diff --git a/Graphics/UI/Gtk/Scrolling/VScrollbar.chs b/Graphics/UI/Gtk/Scrolling/VScrollbar.chs --- a/Graphics/UI/Gtk/Scrolling/VScrollbar.chs +++ b/Graphics/UI/Gtk/Scrolling/VScrollbar.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget VScrollbar -- diff --git a/Graphics/UI/Gtk/Selectors/ColorButton.chs b/Graphics/UI/Gtk/Selectors/ColorButton.chs --- a/Graphics/UI/Gtk/Selectors/ColorButton.chs +++ b/Graphics/UI/Gtk/Selectors/ColorButton.chs @@ -240,7 +240,7 @@ -------------------- -- Signals --- | The ::color-set signal is emitted when the user selects a color. When +-- | The 'colorSet' signal is emitted when the user selects a color. When -- handling this signal, use 'colorButtonGetColor' and 'colorButtonGetAlpha' to -- find out which color was just selected. -- diff --git a/Graphics/UI/Gtk/Selectors/ColorSelection.chs b/Graphics/UI/Gtk/Selectors/ColorSelection.chs --- a/Graphics/UI/Gtk/Selectors/ColorSelection.chs +++ b/Graphics/UI/Gtk/Selectors/ColorSelection.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ColorSelection -- diff --git a/Graphics/UI/Gtk/Selectors/ColorSelectionDialog.chs b/Graphics/UI/Gtk/Selectors/ColorSelectionDialog.chs --- a/Graphics/UI/Gtk/Selectors/ColorSelectionDialog.chs +++ b/Graphics/UI/Gtk/Selectors/ColorSelectionDialog.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ColorSelectionDialog -- diff --git a/Graphics/UI/Gtk/Selectors/FileChooser.chs b/Graphics/UI/Gtk/Selectors/FileChooser.chs --- a/Graphics/UI/Gtk/Selectors/FileChooser.chs +++ b/Graphics/UI/Gtk/Selectors/FileChooser.chs @@ -81,7 +81,7 @@ -- -- * GtkFileChooser key binding example -- --- The default keys that activate the key-binding signals in +-- The default keys that activate the 'keyBinding' signals in -- GtkFileChooserDefaultClass are as follows: -- -- [Signal name] Key @@ -1147,7 +1147,7 @@ -- property (or call the 'fileChooserSetDoOverwriteConfirmation' function), and -- they will automatically get a stock confirmation dialog. Applications which -- need to customize this behavior should do that, and also connect to the --- confirm-overwrite signal. +-- 'confirmOverwrite' signal. -- -- A signal handler for this signal must return a 'FileChooserConfirmation' -- value, which indicates the action to take. If the handler determines that diff --git a/Graphics/UI/Gtk/Selectors/FileSelection.chs b/Graphics/UI/Gtk/Selectors/FileSelection.chs --- a/Graphics/UI/Gtk/Selectors/FileSelection.chs +++ b/Graphics/UI/Gtk/Selectors/FileSelection.chs @@ -18,10 +18,6 @@ -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details. -- --- TODO --- --- Fix fileSelectionQueryButtons --- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional @@ -181,22 +177,6 @@ fileSelectionHideFileopButtons self = {# call file_selection_hide_fileop_buttons #} (toFileSelection self) - --- currently broken --- -- query the widgets of the file selectors buttons --- -- --- -- * this is useful to attach signals handlers to these buttons --- -- --- -- * the buttons are OK & Cancel (in this order) --- -- --- fileSelectionQueryButtons :: FileSelectionClass fsel --- => fsel --- -> IO (Button, Button) --- fileSelectionQueryButtons fsel = --- withForeignPtr (unFileSelection $ toFileSelection fsel) $ \ ptr -> do --- ok <- {#get FileSelection.ok_button #} ptr --- cancel <- {#get FileSelection.cancel_button#} ptr --- return (castToButton ok, castToButton cancel) -- | Will attempt to match @pattern@ to a valid filenames or subdirectories in -- the current directory. If a match can be made, the matched filename will diff --git a/Graphics/UI/Gtk/Selectors/FontButton.chs b/Graphics/UI/Gtk/Selectors/FontButton.chs --- a/Graphics/UI/Gtk/Selectors/FontButton.chs +++ b/Graphics/UI/Gtk/Selectors/FontButton.chs @@ -316,7 +316,7 @@ -------------------- -- Signals --- | The ::font-set signal is emitted when the user selects a font. When +-- | The 'fontSet' signal is emitted when the user selects a font. When -- handling this signal, use 'fontButtonGetFontName' to find out which font was -- just selected. -- diff --git a/Graphics/UI/Gtk/Selectors/FontSelection.chs b/Graphics/UI/Gtk/Selectors/FontSelection.chs --- a/Graphics/UI/Gtk/Selectors/FontSelection.chs +++ b/Graphics/UI/Gtk/Selectors/FontSelection.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget FontSelection -- diff --git a/Graphics/UI/Gtk/Selectors/FontSelectionDialog.chs b/Graphics/UI/Gtk/Selectors/FontSelectionDialog.chs --- a/Graphics/UI/Gtk/Selectors/FontSelectionDialog.chs +++ b/Graphics/UI/Gtk/Selectors/FontSelectionDialog.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget FontSelectionDialog -- @@ -64,6 +65,13 @@ fontSelectionDialogSetFontName, fontSelectionDialogGetPreviewText, fontSelectionDialogSetPreviewText, +#if GTK_CHECK_VERSION(2,14,0) + fontSelectionDialogGetCancelButton, + fontSelectionDialogGetOkButton, +#endif +#if GTK_CHECK_VERSION(2,22,0) + fontSelectionDialogGetFontSelection, +#endif -- * Attributes fontSelectionDialogPreviewText, @@ -135,6 +143,45 @@ {# call font_selection_dialog_set_preview_text #} (toFontSelectionDialog self) textPtr + +#if GTK_CHECK_VERSION(2,14,0) +-- | Gets the 'Cancel' button. +-- +-- * Available since Gtk+ version 2.14 +-- +fontSelectionDialogGetCancelButton :: FontSelectionDialogClass self => self + -> IO Widget -- ^ returns the 'Widget' used in the dialog for the 'Cancel' button. +fontSelectionDialogGetCancelButton self = + makeNewObject mkWidget $ + {#call gtk_font_selection_dialog_get_cancel_button #} + (toFontSelectionDialog self) + +-- | Gets the 'OK' button. +-- +-- * Available since Gtk+ version 2.14 +-- +fontSelectionDialogGetOkButton :: FontSelectionDialogClass self => self + -> IO Widget -- ^ returns the 'Widget' used in the dialog for the 'OK' button. +fontSelectionDialogGetOkButton self = + makeNewObject mkWidget $ + {#call gtk_font_selection_dialog_get_ok_button #} + (toFontSelectionDialog self) + +#endif + +#if GTK_CHECK_VERSION(2,22,0) +-- | Retrieves the 'FontSelection' widget embedded in the dialog. +-- +-- * Available since Gtk+ version 2.22 +-- +fontSelectionDialogGetFontSelection :: FontSelectionDialogClass self => self + -> IO FontSelection -- ^ returns the embedded 'FontSelection' +fontSelectionDialogGetFontSelection self = + makeNewObject mkFontSelection $ + liftM (castPtr :: Ptr Widget -> Ptr FontSelection) $ + {#call gtk_font_selection_dialog_get_font_selection #} + (toFontSelectionDialog self) +#endif -------------------- -- Attributes diff --git a/Graphics/UI/Gtk/Selectors/HSV.chs b/Graphics/UI/Gtk/Selectors/HSV.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Selectors/HSV.chs @@ -0,0 +1,275 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget HSV +-- +-- Author : Andy Stewart +-- +-- Created: 25 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- A \'color wheel\' widget +-- +-- * Module available since Gtk+ version 2.14 +-- +module Graphics.UI.Gtk.Selectors.HSV ( + +-- * Detail +-- +-- | 'HSV' is the \'color wheel\' part of a complete color selector widget. It +-- allows to select a color by determining its 'HSV' components in an intuitive +-- way. Moving the selection around the outer ring changes the hue, and moving +-- the selection point inside the inner triangle changes value and saturation. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----'Widget' +-- | +----HSV +-- @ + +#if GTK_CHECK_VERSION(2,14,0) +-- * Types + HSV, + HSVClass, + castToHSV, + toHSV, + +-- * Constructors + hsvNew, + +-- * Methods + hsvIsAdjusting, + hsvToRgb, + rgbToHsv, + +-- * Attributes + hsvColor, + hsvMetrics, + +-- * Signals + hsvChanged, + hsvMove, +#endif + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.Attributes +import System.Glib.Properties +import Graphics.UI.Gtk.General.Enums (DirectionType (..)) +import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +{#import Graphics.UI.Gtk.Signals#} +{#import Graphics.UI.Gtk.Types#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,14,0) +-------------------- +-- Constructors + +-- | Creates a new 'HSV' color selector. +-- +-- * Available since 2.14 +-- +hsvNew :: IO HSV +hsvNew = + makeNewObject mkHSV $ + liftM (castPtr :: Ptr Widget -> Ptr HSV) $ + {# call gtk_hsv_new #} + +-------------------- +-- Methods + +-- | Sets the current color in an 'HSV' color selector. Color component values +-- must be in the [0.0, 1.0] range. +-- +-- * Available since 2.14 +-- +hsvSetColor :: HSVClass self => self + -> (Double, Double, Double) + -- ^ @(h, s, v)@ + -- @h@ - value for the hue + -- @s@ value for the saturation + -- @v@ value for the value + -> IO () +hsvSetColor self (h, s, v) = + {# call gtk_hsv_set_color #} + (toHSV self) + (realToFrac h) + (realToFrac s) + (realToFrac v) + +-- | Queries the current color in an 'HSV' color selector. Returned values will +-- be in the [0.0, 1.0] range. +-- +hsvGetColor :: HSVClass self => self + -> IO (Double, Double, Double) -- ^ @(h, s, v)@ @h@ - Return value for the hue @s@ - + -- Return value for the saturation @v@ - Return + -- value for the value +hsvGetColor self = + alloca $ \hPtr -> + alloca $ \sPtr -> + alloca $ \vPtr -> do + {# call gtk_hsv_get_color #} + (toHSV self) + hPtr + sPtr + vPtr + h <- peek hPtr + s <- peek sPtr + v <- peek vPtr + return (realToFrac h, realToFrac s, realToFrac v) + +-- | Sets the size and ring width of an 'HSV' color selector. +-- +hsvSetMetrics :: HSVClass self => self + -> (Int, Int) + -- ^ @(size, ringWidth)@ + -- ^ @size@ - Diameter for the hue ring + -- ^ @ringWidth@ - Width of the hue ring + -> IO () +hsvSetMetrics self (size, ringWidth) = + {# call gtk_hsv_set_metrics #} + (toHSV self) + (fromIntegral size) + (fromIntegral ringWidth) + +-- | Queries the size and ring width of an 'HSV' color selector. +-- +hsvGetMetrics :: HSVClass self => self + -> IO (Int, Int) -- ^ @(size, ringWidth)@ + -- @size@ - Return value for the diameter of the hue ring + -- @ringWidth@ - Return value for the width of the hue ring +hsvGetMetrics self = + alloca $ \sizePtr -> + alloca $ \ringWidthPtr -> do + {# call gtk_hsv_get_metrics #} + (toHSV self) + sizePtr + ringWidthPtr + size <- peek sizePtr + ringWidth <- peek ringWidthPtr + return (fromIntegral size, fromIntegral ringWidth) + +-- | An 'HSV' color selector can be said to be adjusting if multiple rapid +-- changes are being made to its value, for example, when the user is adjusting +-- the value with the mouse. This function queries whether the 'HSV' color +-- selector is being adjusted or not. +-- +hsvIsAdjusting :: HSVClass self => self + -> IO Bool -- ^ returns @True@ if clients can ignore changes to the color + -- value, since they may be transitory, or @False@ if they should + -- consider the color value status to be final. +hsvIsAdjusting self = + liftM toBool $ + {# call gtk_hsv_is_adjusting #} + (toHSV self) + +-- | Converts a color from 'HSV' space to RGB. Input values must be in the [0.0, +-- 1.0] range; output values will be in the same range. +-- +hsvToRgb :: + (Double, Double, Double) + -- ^ @(h, s, v)@ + -- @h@ - value for the hue + -- @s@ value for the saturation + -- @v@ value for the value + -> (Double, Double, Double) -- ^ @(r, g, b)@ @r@ - Return value for the red + -- component @g@ - Return value for the green + -- component @b@ - Return value for the blue + -- component +hsvToRgb (h, s, v) = + unsafePerformIO $ + alloca $ \rPtr -> + alloca $ \gPtr -> + alloca $ \bPtr -> do + {# call gtk_hsv_to_rgb #} + (realToFrac h) + (realToFrac s) + (realToFrac v) + rPtr + gPtr + bPtr + r <- peek rPtr + g <- peek gPtr + b <- peek bPtr + return (realToFrac r, realToFrac g, realToFrac b) + +-- | Converts a color from RGB space to 'HSV'. Input values must be in the [0.0, 1.0] range; output values +-- will be in the same range. +rgbToHsv :: + (Double, Double, Double) + -- ^ @(r, g, b)@ @r@ value for the red component + -- @g@ value for the green component + -- @b@ value for the blue component + -> (Double, Double, Double) + -- ^ @(h, s, v)@ + -- @h@ - Return value for the hue + -- @s@ - Return value for the saturation + -- @v@ - Return value for the value +rgbToHsv (r, g, b) = + unsafePerformIO $ + alloca $ \hPtr -> + alloca $ \sPtr -> + alloca $ \vPtr -> do + {# call rgb_to_hsv #} + (realToFrac r) + (realToFrac g) + (realToFrac b) + hPtr + sPtr + vPtr + h <- peek hPtr + s <- peek sPtr + v <- peek vPtr + return (realToFrac h, realToFrac s, realToFrac v) + +-------------------- +-- Attributes +-- | Color in an 'HSV' color selector. +-- Color component values must be in the [0.0, 1.0] range. +hsvColor :: HSVClass self => Attr self (Double, Double, Double) +hsvColor = newAttr + hsvGetColor + hsvSetColor + +-- | The size and ring width of an 'HSV' color selector. +hsvMetrics :: HSVClass self => Attr self (Int, Int) +hsvMetrics = newAttr + hsvGetMetrics + hsvSetMetrics + +-------------------- +-- Signals + +-- | +-- +hsvChanged :: HSVClass self => Signal self (IO ()) +hsvChanged = Signal (connect_NONE__NONE "changed") + +-- | +-- +hsvMove :: HSVClass self => Signal self (DirectionType -> IO ()) +hsvMove = Signal (connect_ENUM__NONE "move") + +#endif diff --git a/Graphics/UI/Gtk/Signals.chs b/Graphics/UI/Gtk/Signals.chs --- a/Graphics/UI/Gtk/Signals.chs +++ b/Graphics/UI/Gtk/Signals.chs @@ -96,13 +96,20 @@ connect_ENUM_BOOL__BOOL, connect_BOXED_INT__NONE, connect_OBJECT_INT_INT_BOOL_OBJECT__BOOL, + connect_INT_STRING_INT__NONE, + connect_STRING_INT_ENUM_INT__NONE, + connect_OBJECT__BOOL, + connect_OBJECT_INT_OBJECT__NONE, + connect_OBJECT_OBJECT_OBJECT__NONE, + connect_OBJECT_OBJECT_OBJECT__BOOL, + connect_ENUM_PTR__NONE, ) where import Control.Monad (liftM) import System.Glib.FFI -import System.Glib.UTFString (peekUTFString) +import System.Glib.UTFString (peekUTFString,maybePeekUTFString) import System.Glib.GError (failOnGError) {#import System.Glib.Signals#} {#import System.Glib.GObject#} @@ -847,4 +854,99 @@ makeNewGObject (GObject, objectUnrefFromMainloop) (return obj5) >>= \obj5' -> makeNewGObject (GObject, objectUnrefFromMainloop) (return obj1) >>= \obj1' -> user (unsafeCastGObject obj1') int2 int3 bool4 (unsafeCastGObject obj5') + +connect_INT_STRING_INT__NONE :: + GObjectClass obj => SignalName -> + ConnectAfter -> obj -> + (Int -> String -> Int -> IO ()) -> + IO (ConnectId obj) +connect_INT_STRING_INT__NONE signal after obj user = + connectGeneric signal after obj action + where action :: Ptr GObject -> Int -> CString -> Int -> IO () + action _ int1 str2 int3 = + failOnGError $ + peekUTFString str2 >>= \str2' -> + user int1 str2' int3 + +connect_STRING_INT_ENUM_INT__NONE :: + (Enum c, GObjectClass obj) => SignalName -> + ConnectAfter -> obj -> + (String -> Int -> c -> Int -> IO ()) -> + IO (ConnectId obj) +connect_STRING_INT_ENUM_INT__NONE signal after obj user = + connectGeneric signal after obj action + where action :: Ptr GObject -> CString -> Int -> Int -> Int -> IO () + action _ str1 int2 enum3 int4 = + failOnGError $ + peekUTFString str1 >>= \str1' -> + user str1' int2 (toEnum enum3) int4 + +connect_OBJECT__BOOL :: + (GObjectClass a', GObjectClass obj) => SignalName -> + ConnectAfter -> obj -> + (a' -> IO Bool) -> + IO (ConnectId obj) +connect_OBJECT__BOOL signal after obj user = + connectGeneric signal after obj action + where action :: Ptr GObject -> Ptr GObject -> IO Bool + action _ obj1 = + failOnGError $ + makeNewGObject (GObject, objectUnref) (return obj1) >>= \obj1' -> + user (unsafeCastGObject obj1') + +connect_OBJECT_INT_OBJECT__NONE :: + (GObjectClass a', GObjectClass c', GObjectClass obj) => SignalName -> + ConnectAfter -> obj -> + (a' -> Int -> c' -> IO ()) -> + IO (ConnectId obj) +connect_OBJECT_INT_OBJECT__NONE signal after obj user = + connectGeneric signal after obj action + where action :: Ptr GObject -> Ptr GObject -> Int -> Ptr GObject -> IO () + action _ obj1 int2 obj3 = + failOnGError $ + makeNewGObject (GObject, objectUnref) (return obj3) >>= \obj3' -> + makeNewGObject (GObject, objectUnref) (return obj1) >>= \obj1' -> + user (unsafeCastGObject obj1') int2 (unsafeCastGObject obj3') + +connect_OBJECT_OBJECT_OBJECT__NONE :: + (GObjectClass a', GObjectClass b', GObjectClass c', GObjectClass obj) => SignalName -> + ConnectAfter -> obj -> + (a' -> b' -> c' -> IO ()) -> + IO (ConnectId obj) +connect_OBJECT_OBJECT_OBJECT__NONE signal after obj user = + connectGeneric signal after obj action + where action :: Ptr GObject -> Ptr GObject -> Ptr GObject -> Ptr GObject -> IO () + action _ obj1 obj2 obj3 = + failOnGError $ + makeNewGObject (GObject, objectUnref) (return obj3) >>= \obj3' -> + makeNewGObject (GObject, objectUnref) (return obj2) >>= \obj2' -> + makeNewGObject (GObject, objectUnref) (return obj1) >>= \obj1' -> + user (unsafeCastGObject obj1') (unsafeCastGObject obj2') (unsafeCastGObject obj3') + +connect_OBJECT_OBJECT_OBJECT__BOOL :: + (GObjectClass a', GObjectClass b', GObjectClass c', GObjectClass obj) => SignalName -> + ConnectAfter -> obj -> + (a' -> b' -> c' -> IO Bool) -> + IO (ConnectId obj) +connect_OBJECT_OBJECT_OBJECT__BOOL signal after obj user = + connectGeneric signal after obj action + where action :: Ptr GObject -> Ptr GObject -> Ptr GObject -> Ptr GObject -> IO Bool + action _ obj1 obj2 obj3 = + failOnGError $ + makeNewGObject (GObject, objectUnref) (return obj3) >>= \obj3' -> + makeNewGObject (GObject, objectUnref) (return obj2) >>= \obj2' -> + makeNewGObject (GObject, objectUnref) (return obj1) >>= \obj1' -> + user (unsafeCastGObject obj1') (unsafeCastGObject obj2') (unsafeCastGObject obj3') + +connect_ENUM_PTR__NONE :: + (Enum a, GObjectClass obj) => SignalName -> + ConnectAfter -> obj -> + (a -> Ptr b -> IO ()) -> + IO (ConnectId obj) +connect_ENUM_PTR__NONE signal after obj user = + connectGeneric signal after obj action + where action :: Ptr GObject -> Int -> Ptr () -> IO () + action _ enum1 ptr2 = + failOnGError $ + user (toEnum enum1) (castPtr ptr2) diff --git a/Graphics/UI/Gtk/Special/HRuler.chs b/Graphics/UI/Gtk/Special/HRuler.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Special/HRuler.chs @@ -0,0 +1,76 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget HRuler +-- +-- Author : Andy Stewart +-- +-- Created: 28 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- A horizontal ruler +-- +module Graphics.UI.Gtk.Special.HRuler ( + +-- * Detail +-- +-- | The 'HRuler' widget is a widget arranged horizontally creating a ruler that +-- is utilized around other widgets such as a text widget. The ruler is used to +-- show the location of the mouse on the window and to show the size of the +-- window in specified units. The available units of measurement are 'Pixels', +-- 'Inches' and 'Centimeters'. 'Pixels' is the default. rulers. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----'Widget' +-- | +----'Ruler' +-- | +----HRuler +-- @ + +-- * Types + HRuler, + HRulerClass, + castToHRuler, + toHRuler, + +-- * Constructors + hRulerNew, + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +{#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) +{#import Graphics.UI.Gtk.Types#} + +{# context lib="gtk" prefix="gtk" #} + +-------------------- +-- Constructors + +-- | Creates a new horizontal ruler. +-- +hRulerNew :: IO HRuler +hRulerNew = + makeNewObject mkHRuler $ + liftM (castPtr :: Ptr Widget -> Ptr HRuler) $ + {# call gtk_hruler_new #} diff --git a/Graphics/UI/Gtk/Special/Ruler.chs b/Graphics/UI/Gtk/Special/Ruler.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Special/Ruler.chs @@ -0,0 +1,174 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget Ruler +-- +-- Author : Andy Stewart +-- +-- Created: 28 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- Base class for horizontal or vertical rulers +-- +module Graphics.UI.Gtk.Special.Ruler ( + +-- * Detail +-- +-- | The 'Ruler' widget is a base class for horizontal and vertical rulers. +-- Rulers are used to show the mouse pointer's location in a window. The ruler +-- can either be horizontal or vertical on the window. Within the ruler a small +-- triangle indicates the location of the mouse relative to the horizontal or +-- vertical ruler. See 'HRuler' to learn how to create a new horizontal ruler. +-- See 'VRuler' to learn how to create a new vertical ruler. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----'Widget' +-- | +----Ruler +-- | +----'HRuler' +-- | +----'VRuler' +-- @ + +-- * Types + Ruler, + RulerClass, + castToRuler, + toRuler, + +-- * Enums + MetricType (..), + +-- * Attributes + rulerRange, + rulerLower, + rulerUpper, + rulerPosition, + rulerMaxSize, +#if GTK_CHECK_VERSION(2,8,0) + rulerMetric, +#endif + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.Attributes +import System.Glib.Properties +import Graphics.UI.Gtk.General.Enums +{#import Graphics.UI.Gtk.Types#} + +{# context lib="gtk" prefix="gtk" #} + +-------------------- +-- Methods + +-- | This sets the range of the ruler. +-- +rulerSetRange :: RulerClass self => self + -> (Double + ,Double + ,Double + ,Double) + -- ^ @lower@ - the lower limit of the ruler + -- ^ @upper@ - the upper limit of the ruler + -- ^ @position@ - the mark on the ruler + -- ^ @maxSize@ - the maximum size of the ruler used when calculating the space to leave for the text + -> IO () +rulerSetRange self (lower, upper, position, maxSize) = + {# call gtk_ruler_set_range #} + (toRuler self) + (realToFrac lower) + (realToFrac upper) + (realToFrac position) + (realToFrac maxSize) + +-- | Retrieves values indicating the range and current position of a 'Ruler'. +-- See 'rulerSetRange'. +-- +rulerGetRange :: RulerClass self => self + -> IO (Double, Double, Double, Double) +rulerGetRange self = + alloca $ \lowerPtr -> + alloca $ \upperPtr -> + alloca $ \positionPtr -> + alloca $ \maxSizePtr -> do + {# call gtk_ruler_get_range #} + (toRuler self) + lowerPtr + upperPtr + positionPtr + maxSizePtr + lower <- peek lowerPtr + upper <- peek upperPtr + position <- peek positionPtr + maxSize <- peek maxSizePtr + return (realToFrac lower, realToFrac upper, realToFrac position, realToFrac maxSize) + +-------------------- +-- Attributes + +-- | Range of ruler +-- +rulerRange :: RulerClass self => Attr self (Double, Double, Double, Double) +rulerRange = newAttr + rulerGetRange + rulerSetRange + +-- | Lower limit of ruler. +-- +-- Default value: 0 +-- +rulerLower :: RulerClass self => Attr self Double +rulerLower = newAttrFromDoubleProperty "lower" + +-- | Upper limit of ruler. +-- +-- Default value: 0 +-- +rulerUpper :: RulerClass self => Attr self Double +rulerUpper = newAttrFromDoubleProperty "upper" + +-- | Position of mark on the ruler. +-- +-- Default value: 0 +-- +rulerPosition :: RulerClass self => Attr self Double +rulerPosition = newAttrFromDoubleProperty "position" + +-- | Maximum size of the ruler. +-- +-- Default value: 0 +-- +rulerMaxSize :: RulerClass self => Attr self Double +rulerMaxSize = newAttrFromDoubleProperty "max-size" + +#if GTK_CHECK_VERSION(2,8,0) +-- | The metric used for the ruler. +-- +-- Default value: ''Pixels'' +-- +-- Since 2.8 +-- +rulerMetric :: RulerClass self => Attr self MetricType +rulerMetric = newAttrFromEnumProperty "metric" + {# call pure unsafe gtk_metric_type_get_type #} +#endif diff --git a/Graphics/UI/Gtk/Special/VRuler.chs b/Graphics/UI/Gtk/Special/VRuler.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Special/VRuler.chs @@ -0,0 +1,76 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget VRuler +-- +-- Author : Andy Stewart +-- +-- Created: 28 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- A vertical ruler +-- +module Graphics.UI.Gtk.Special.VRuler ( + +-- * Detail +-- +-- | The 'VRuler' widget is a widget arranged vertically creating a ruler that +-- is utilized around other widgets such as a text widget. The ruler is used to +-- show the location of the mouse on the window and to show the size of the +-- window in specified units. The available units of measurement are 'Pixels', +-- 'Inches' and 'Centimeters'. 'Pixels' is the default. rulers. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----'Widget' +-- | +----'Ruler' +-- | +----VRuler +-- @ + +-- * Types + VRuler, + VRulerClass, + castToVRuler, + toVRuler, + +-- * Constructors + vRulerNew, + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +{#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) +{#import Graphics.UI.Gtk.Types#} + +{# context lib="gtk" prefix="gtk" #} + +-------------------- +-- Constructors + +-- | Creates a new vertical ruler +-- +vRulerNew :: IO VRuler +vRulerNew = + makeNewObject mkVRuler $ + liftM (castPtr :: Ptr Widget -> Ptr VRuler) $ + {# call gtk_vruler_new #} 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 @@ -36,6 +36,54 @@ module System.Glib.GObject, module Graphics.UI.Gtk.General.Threading, + AtkObject(AtkObject), AtkObjectClass, + toAtkObject, + mkAtkObject, unAtkObject, + castToAtkObject, gTypeAtkObject, + Accessible(Accessible), AccessibleClass, + toAccessible, + mkAccessible, unAccessible, + castToAccessible, gTypeAccessible, + Keymap(Keymap), KeymapClass, + toKeymap, + mkKeymap, unKeymap, + castToKeymap, gTypeKeymap, + DisplayManager(DisplayManager), DisplayManagerClass, + toDisplayManager, + mkDisplayManager, unDisplayManager, + castToDisplayManager, gTypeDisplayManager, + AppLaunchContext(AppLaunchContext), AppLaunchContextClass, + toAppLaunchContext, + mkAppLaunchContext, unAppLaunchContext, + castToAppLaunchContext, gTypeAppLaunchContext, + PrintSettings(PrintSettings), PrintSettingsClass, + toPrintSettings, + mkPrintSettings, unPrintSettings, + castToPrintSettings, gTypePrintSettings, + PrintOperation(PrintOperation), PrintOperationClass, + toPrintOperation, + mkPrintOperation, unPrintOperation, + castToPrintOperation, gTypePrintOperation, + PrintOperationPreview(PrintOperationPreview), PrintOperationPreviewClass, + toPrintOperationPreview, + mkPrintOperationPreview, unPrintOperationPreview, + castToPrintOperationPreview, gTypePrintOperationPreview, + PageSetup(PageSetup), PageSetupClass, + toPageSetup, + mkPageSetup, unPageSetup, + castToPageSetup, gTypePageSetup, + PrintContext(PrintContext), PrintContextClass, + toPrintContext, + mkPrintContext, unPrintContext, + castToPrintContext, gTypePrintContext, + RecentChooser(RecentChooser), RecentChooserClass, + toRecentChooser, + mkRecentChooser, unRecentChooser, + castToRecentChooser, gTypeRecentChooser, + RecentManager(RecentManager), RecentManagerClass, + toRecentManager, + mkRecentManager, unRecentManager, + castToRecentManager, gTypeRecentManager, Drawable(Drawable), DrawableClass, toDrawable, mkDrawable, unDrawable, @@ -124,10 +172,18 @@ toObject, mkObject, unObject, castToObject, gTypeObject, + RecentFilter(RecentFilter), RecentFilterClass, + toRecentFilter, + mkRecentFilter, unRecentFilter, + castToRecentFilter, gTypeRecentFilter, Widget(Widget), WidgetClass, toWidget, mkWidget, unWidget, castToWidget, gTypeWidget, + HSV(HSV), HSVClass, + toHSV, + mkHSV, unHSV, + castToHSV, gTypeHSV, Misc(Misc), MiscClass, toMisc, mkMisc, unMisc, @@ -156,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, @@ -176,6 +240,18 @@ toButton, mkButton, unButton, castToButton, gTypeButton, + ScaleButton(ScaleButton), ScaleButtonClass, + toScaleButton, + mkScaleButton, unScaleButton, + castToScaleButton, gTypeScaleButton, + VolumeButton(VolumeButton), VolumeButtonClass, + toVolumeButton, + mkVolumeButton, unVolumeButton, + castToVolumeButton, gTypeVolumeButton, + LinkButton(LinkButton), LinkButtonClass, + toLinkButton, + mkLinkButton, unLinkButton, + castToLinkButton, gTypeLinkButton, ToggleButton(ToggleButton), ToggleButtonClass, toToggleButton, mkToggleButton, unToggleButton, @@ -236,6 +312,14 @@ toWindow, mkWindow, unWindow, castToWindow, gTypeWindow, + Assistant(Assistant), AssistantClass, + toAssistant, + mkAssistant, unAssistant, + castToAssistant, gTypeAssistant, + OffscreenWindow(OffscreenWindow), OffscreenWindowClass, + toOffscreenWindow, + mkOffscreenWindow, unOffscreenWindow, + castToOffscreenWindow, gTypeOffscreenWindow, Dialog(Dialog), DialogClass, toDialog, mkDialog, unDialog, @@ -344,6 +428,10 @@ toVBox, mkVBox, unVBox, castToVBox, gTypeVBox, + RecentChooserWidget(RecentChooserWidget), RecentChooserWidgetClass, + toRecentChooserWidget, + mkRecentChooserWidget, unRecentChooserWidget, + castToRecentChooserWidget, gTypeRecentChooserWidget, ColorSelection(ColorSelection), ColorSelectionClass, toColorSelection, mkColorSelection, unColorSelection, @@ -360,6 +448,10 @@ toHBox, mkHBox, unHBox, castToHBox, gTypeHBox, + InfoBar(InfoBar), InfoBarClass, + toInfoBar, + mkInfoBar, unInfoBar, + castToInfoBar, gTypeInfoBar, Combo(Combo), ComboClass, toCombo, mkCombo, unCombo, @@ -416,6 +508,10 @@ toMenu, mkMenu, unMenu, castToMenu, gTypeMenu, + RecentChooserMenu(RecentChooserMenu), RecentChooserMenuClass, + toRecentChooserMenu, + mkRecentChooserMenu, unRecentChooserMenu, + castToRecentChooserMenu, gTypeRecentChooserMenu, MenuBar(MenuBar), MenuBarClass, toMenuBar, mkMenuBar, unMenuBar, @@ -456,6 +552,10 @@ toDrawingArea, mkDrawingArea, unDrawingArea, castToDrawingArea, gTypeDrawingArea, + Spinner(Spinner), SpinnerClass, + toSpinner, + mkSpinner, unSpinner, + castToSpinner, gTypeSpinner, Entry(Entry), EntryClass, toEntry, mkEntry, unEntry, @@ -540,6 +640,10 @@ toIMMulticontext, mkIMMulticontext, unIMMulticontext, castToIMMulticontext, gTypeIMMulticontext, + IMContextSimple(IMContextSimple), IMContextSimpleClass, + toIMContextSimple, + mkIMContextSimple, unIMContextSimple, + castToIMContextSimple, gTypeIMContextSimple, ItemFactory(ItemFactory), ItemFactoryClass, toItemFactory, mkItemFactory, unItemFactory, @@ -556,6 +660,10 @@ toCellRenderer, mkCellRenderer, unCellRenderer, castToCellRenderer, gTypeCellRenderer, + CellRendererSpinner(CellRendererSpinner), CellRendererSpinnerClass, + toCellRendererSpinner, + mkCellRendererSpinner, unCellRendererSpinner, + castToCellRendererSpinner, gTypeCellRendererSpinner, CellRendererPixbuf(CellRendererPixbuf), CellRendererPixbufClass, toCellRendererPixbuf, mkCellRendererPixbuf, unCellRendererPixbuf, @@ -564,6 +672,14 @@ toCellRendererText, mkCellRendererText, unCellRendererText, castToCellRendererText, gTypeCellRendererText, + CellRendererAccel(CellRendererAccel), CellRendererAccelClass, + toCellRendererAccel, + mkCellRendererAccel, unCellRendererAccel, + castToCellRendererAccel, gTypeCellRendererAccel, + CellRendererSpin(CellRendererSpin), CellRendererSpinClass, + toCellRendererSpin, + mkCellRendererSpin, unCellRendererSpin, + castToCellRendererSpin, gTypeCellRendererSpin, CellRendererCombo(CellRendererCombo), CellRendererComboClass, toCellRendererCombo, mkCellRendererCombo, unCellRendererCombo, @@ -652,10 +768,18 @@ toEntryCompletion, mkEntryCompletion, unEntryCompletion, castToEntryCompletion, gTypeEntryCompletion, + EntryBuffer(EntryBuffer), EntryBufferClass, + toEntryBuffer, + mkEntryBuffer, unEntryBuffer, + castToEntryBuffer, gTypeEntryBuffer, Action(Action), ActionClass, toAction, mkAction, unAction, castToAction, gTypeAction, + RecentAction(RecentAction), RecentActionClass, + toRecentAction, + mkRecentAction, unRecentAction, + castToRecentAction, gTypeRecentAction, ToggleAction(ToggleAction), ToggleActionClass, toToggleAction, mkToggleAction, unToggleAction, @@ -676,6 +800,10 @@ toWindowGroup, mkWindowGroup, unWindowGroup, castToWindowGroup, gTypeWindowGroup, + CellEditable(CellEditable), CellEditableClass, + toCellEditable, + mkCellEditable, unCellEditable, + castToCellEditable, gTypeCellEditable, Editable(Editable), EditableClass, toEditable, mkEditable, unEditable, @@ -711,6 +839,283 @@ | otherwise -> error $ "Cannot cast object to " ++ objTypeName +-- ****************************************************************** AtkObject + +{#pointer *AtkObject foreign newtype #} deriving (Eq,Ord) + +mkAtkObject = (AtkObject, objectUnrefFromMainloop) +unAtkObject (AtkObject o) = o + +class GObjectClass o => AtkObjectClass o +toAtkObject :: AtkObjectClass o => o -> AtkObject +toAtkObject = unsafeCastGObject . toGObject + +instance AtkObjectClass AtkObject +instance GObjectClass AtkObject where + toGObject = GObject . castForeignPtr . unAtkObject + unsafeCastGObject = AtkObject . castForeignPtr . unGObject + +castToAtkObject :: GObjectClass obj => obj -> AtkObject +castToAtkObject = castTo gTypeAtkObject "AtkObject" + +gTypeAtkObject :: GType +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) + +mkKeymap = (Keymap, objectUnrefFromMainloop) +unKeymap (Keymap o) = o + +class GObjectClass o => KeymapClass o +toKeymap :: KeymapClass o => o -> Keymap +toKeymap = unsafeCastGObject . toGObject + +instance KeymapClass Keymap +instance GObjectClass Keymap where + toGObject = GObject . castForeignPtr . unKeymap + unsafeCastGObject = Keymap . castForeignPtr . unGObject + +castToKeymap :: GObjectClass obj => obj -> Keymap +castToKeymap = castTo gTypeKeymap "Keymap" + +gTypeKeymap :: GType +gTypeKeymap = + {# call fun unsafe gdk_keymap_get_type #} + +-- ************************************************************* DisplayManager + +{#pointer *GdkDisplayManager as DisplayManager foreign newtype #} deriving (Eq,Ord) + +mkDisplayManager = (DisplayManager, objectUnrefFromMainloop) +unDisplayManager (DisplayManager o) = o + +class GObjectClass o => DisplayManagerClass o +toDisplayManager :: DisplayManagerClass o => o -> DisplayManager +toDisplayManager = unsafeCastGObject . toGObject + +instance DisplayManagerClass DisplayManager +instance GObjectClass DisplayManager where + toGObject = GObject . castForeignPtr . unDisplayManager + unsafeCastGObject = DisplayManager . castForeignPtr . unGObject + +castToDisplayManager :: GObjectClass obj => obj -> DisplayManager +castToDisplayManager = castTo gTypeDisplayManager "DisplayManager" + +gTypeDisplayManager :: GType +gTypeDisplayManager = + {# call fun unsafe gdk_display_manager_get_type #} + +-- *********************************************************** AppLaunchContext + +{#pointer *GdkAppLaunchContext as AppLaunchContext foreign newtype #} deriving (Eq,Ord) + +mkAppLaunchContext = (AppLaunchContext, objectUnrefFromMainloop) +unAppLaunchContext (AppLaunchContext o) = o + +class GObjectClass o => AppLaunchContextClass o +toAppLaunchContext :: AppLaunchContextClass o => o -> AppLaunchContext +toAppLaunchContext = unsafeCastGObject . toGObject + +instance AppLaunchContextClass AppLaunchContext +instance GObjectClass AppLaunchContext where + toGObject = GObject . castForeignPtr . unAppLaunchContext + unsafeCastGObject = AppLaunchContext . castForeignPtr . unGObject + +castToAppLaunchContext :: GObjectClass obj => obj -> AppLaunchContext +castToAppLaunchContext = castTo gTypeAppLaunchContext "AppLaunchContext" + +gTypeAppLaunchContext :: GType +gTypeAppLaunchContext = + {# call fun unsafe gdk_app_launch_context_get_type #} + +-- ************************************************************** PrintSettings + +{#pointer *PrintSettings foreign newtype #} deriving (Eq,Ord) + +mkPrintSettings = (PrintSettings, objectUnrefFromMainloop) +unPrintSettings (PrintSettings o) = o + +class GObjectClass o => PrintSettingsClass o +toPrintSettings :: PrintSettingsClass o => o -> PrintSettings +toPrintSettings = unsafeCastGObject . toGObject + +instance PrintSettingsClass PrintSettings +instance GObjectClass PrintSettings where + toGObject = GObject . castForeignPtr . unPrintSettings + unsafeCastGObject = PrintSettings . castForeignPtr . unGObject + +castToPrintSettings :: GObjectClass obj => obj -> PrintSettings +castToPrintSettings = castTo gTypePrintSettings "PrintSettings" + +gTypePrintSettings :: GType +gTypePrintSettings = + {# call fun unsafe gtk_print_settings_get_type #} + +-- ************************************************************* PrintOperation + +{#pointer *PrintOperation foreign newtype #} deriving (Eq,Ord) + +mkPrintOperation = (PrintOperation, objectUnrefFromMainloop) +unPrintOperation (PrintOperation o) = o + +class GObjectClass o => PrintOperationClass o +toPrintOperation :: PrintOperationClass o => o -> PrintOperation +toPrintOperation = unsafeCastGObject . toGObject + +instance PrintOperationClass PrintOperation +instance GObjectClass PrintOperation where + toGObject = GObject . castForeignPtr . unPrintOperation + unsafeCastGObject = PrintOperation . castForeignPtr . unGObject + +castToPrintOperation :: GObjectClass obj => obj -> PrintOperation +castToPrintOperation = castTo gTypePrintOperation "PrintOperation" + +gTypePrintOperation :: GType +gTypePrintOperation = + {# call fun unsafe gtk_print_operation_get_type #} + +-- ****************************************************** PrintOperationPreview + +{#pointer *PrintOperationPreview foreign newtype #} deriving (Eq,Ord) + +mkPrintOperationPreview = (PrintOperationPreview, objectUnrefFromMainloop) +unPrintOperationPreview (PrintOperationPreview o) = o + +class GObjectClass o => PrintOperationPreviewClass o +toPrintOperationPreview :: PrintOperationPreviewClass o => o -> PrintOperationPreview +toPrintOperationPreview = unsafeCastGObject . toGObject + +instance PrintOperationPreviewClass PrintOperationPreview +instance GObjectClass PrintOperationPreview where + toGObject = GObject . castForeignPtr . unPrintOperationPreview + unsafeCastGObject = PrintOperationPreview . castForeignPtr . unGObject + +castToPrintOperationPreview :: GObjectClass obj => obj -> PrintOperationPreview +castToPrintOperationPreview = castTo gTypePrintOperationPreview "PrintOperationPreview" + +gTypePrintOperationPreview :: GType +gTypePrintOperationPreview = + {# call fun unsafe gtk_print_operation_preview_get_type #} + +-- ****************************************************************** PageSetup + +{#pointer *PageSetup foreign newtype #} deriving (Eq,Ord) + +mkPageSetup = (PageSetup, objectUnrefFromMainloop) +unPageSetup (PageSetup o) = o + +class GObjectClass o => PageSetupClass o +toPageSetup :: PageSetupClass o => o -> PageSetup +toPageSetup = unsafeCastGObject . toGObject + +instance PageSetupClass PageSetup +instance GObjectClass PageSetup where + toGObject = GObject . castForeignPtr . unPageSetup + unsafeCastGObject = PageSetup . castForeignPtr . unGObject + +castToPageSetup :: GObjectClass obj => obj -> PageSetup +castToPageSetup = castTo gTypePageSetup "PageSetup" + +gTypePageSetup :: GType +gTypePageSetup = + {# call fun unsafe gtk_page_setup_get_type #} + +-- *************************************************************** PrintContext + +{#pointer *PrintContext foreign newtype #} deriving (Eq,Ord) + +mkPrintContext = (PrintContext, objectUnrefFromMainloop) +unPrintContext (PrintContext o) = o + +class GObjectClass o => PrintContextClass o +toPrintContext :: PrintContextClass o => o -> PrintContext +toPrintContext = unsafeCastGObject . toGObject + +instance PrintContextClass PrintContext +instance GObjectClass PrintContext where + toGObject = GObject . castForeignPtr . unPrintContext + unsafeCastGObject = PrintContext . castForeignPtr . unGObject + +castToPrintContext :: GObjectClass obj => obj -> PrintContext +castToPrintContext = castTo gTypePrintContext "PrintContext" + +gTypePrintContext :: GType +gTypePrintContext = + {# call fun unsafe gtk_print_context_get_type #} + +-- ************************************************************** RecentChooser + +{#pointer *RecentChooser foreign newtype #} deriving (Eq,Ord) + +mkRecentChooser = (RecentChooser, objectUnrefFromMainloop) +unRecentChooser (RecentChooser o) = o + +class GObjectClass o => RecentChooserClass o +toRecentChooser :: RecentChooserClass o => o -> RecentChooser +toRecentChooser = unsafeCastGObject . toGObject + +instance RecentChooserClass RecentChooser +instance GObjectClass RecentChooser where + toGObject = GObject . castForeignPtr . unRecentChooser + unsafeCastGObject = RecentChooser . castForeignPtr . unGObject + +castToRecentChooser :: GObjectClass obj => obj -> RecentChooser +castToRecentChooser = castTo gTypeRecentChooser "RecentChooser" + +gTypeRecentChooser :: GType +gTypeRecentChooser = + {# call fun unsafe gtk_recent_chooser_get_type #} + +-- ************************************************************** RecentManager + +{#pointer *RecentManager foreign newtype #} deriving (Eq,Ord) + +mkRecentManager = (RecentManager, objectUnrefFromMainloop) +unRecentManager (RecentManager o) = o + +class GObjectClass o => RecentManagerClass o +toRecentManager :: RecentManagerClass o => o -> RecentManager +toRecentManager = unsafeCastGObject . toGObject + +instance RecentManagerClass RecentManager +instance GObjectClass RecentManager where + toGObject = GObject . castForeignPtr . unRecentManager + unsafeCastGObject = RecentManager . castForeignPtr . unGObject + +castToRecentManager :: GObjectClass obj => obj -> RecentManager +castToRecentManager = castTo gTypeRecentManager "RecentManager" + +gTypeRecentManager :: GType +gTypeRecentManager = + {# call fun unsafe gtk_recent_manager_get_type #} + -- ******************************************************************* Drawable {#pointer *GdkDrawable as Drawable foreign newtype #} deriving (Eq,Ord) @@ -1220,6 +1625,30 @@ gTypeObject = {# call fun unsafe gtk_object_get_type #} +-- *************************************************************** RecentFilter + +{#pointer *RecentFilter foreign newtype #} deriving (Eq,Ord) + +mkRecentFilter = (RecentFilter, objectUnrefFromMainloop) +unRecentFilter (RecentFilter o) = o + +class ObjectClass o => RecentFilterClass o +toRecentFilter :: RecentFilterClass o => o -> RecentFilter +toRecentFilter = unsafeCastGObject . toGObject + +instance RecentFilterClass RecentFilter +instance ObjectClass RecentFilter +instance GObjectClass RecentFilter where + toGObject = GObject . castForeignPtr . unRecentFilter + unsafeCastGObject = RecentFilter . castForeignPtr . unGObject + +castToRecentFilter :: GObjectClass obj => obj -> RecentFilter +castToRecentFilter = castTo gTypeRecentFilter "RecentFilter" + +gTypeRecentFilter :: GType +gTypeRecentFilter = + {# call fun unsafe gtk_recent_filter_get_type #} + -- ********************************************************************* Widget {#pointer *Widget foreign newtype #} deriving (Eq,Ord) @@ -1244,6 +1673,31 @@ gTypeWidget = {# call fun unsafe gtk_widget_get_type #} +-- ************************************************************************ HSV + +{#pointer *HSV foreign newtype #} deriving (Eq,Ord) + +mkHSV = (HSV, objectUnrefFromMainloop) +unHSV (HSV o) = o + +class WidgetClass o => HSVClass o +toHSV :: HSVClass o => o -> HSV +toHSV = unsafeCastGObject . toGObject + +instance HSVClass HSV +instance WidgetClass HSV +instance ObjectClass HSV +instance GObjectClass HSV where + toGObject = GObject . castForeignPtr . unHSV + unsafeCastGObject = HSV . castForeignPtr . unGObject + +castToHSV :: GObjectClass obj => obj -> HSV +castToHSV = castTo gTypeHSV "HSV" + +gTypeHSV :: GType +gTypeHSV = + {# call fun unsafe gtk_hsv_get_type #} + -- *********************************************************************** Misc {#pointer *Misc foreign newtype #} deriving (Eq,Ord) @@ -1426,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) @@ -1561,6 +2067,91 @@ gTypeButton = {# call fun unsafe gtk_button_get_type #} +-- **************************************************************** ScaleButton + +{#pointer *ScaleButton foreign newtype #} deriving (Eq,Ord) + +mkScaleButton = (ScaleButton, objectUnrefFromMainloop) +unScaleButton (ScaleButton o) = o + +class ButtonClass o => ScaleButtonClass o +toScaleButton :: ScaleButtonClass o => o -> ScaleButton +toScaleButton = unsafeCastGObject . toGObject + +instance ScaleButtonClass ScaleButton +instance ButtonClass ScaleButton +instance BinClass ScaleButton +instance ContainerClass ScaleButton +instance WidgetClass ScaleButton +instance ObjectClass ScaleButton +instance GObjectClass ScaleButton where + toGObject = GObject . castForeignPtr . unScaleButton + unsafeCastGObject = ScaleButton . castForeignPtr . unGObject + +castToScaleButton :: GObjectClass obj => obj -> ScaleButton +castToScaleButton = castTo gTypeScaleButton "ScaleButton" + +gTypeScaleButton :: GType +gTypeScaleButton = + {# call fun unsafe gtk_scale_button_get_type #} + +-- *************************************************************** VolumeButton + +{#pointer *VolumeButton foreign newtype #} deriving (Eq,Ord) + +mkVolumeButton = (VolumeButton, objectUnrefFromMainloop) +unVolumeButton (VolumeButton o) = o + +class ScaleButtonClass o => VolumeButtonClass o +toVolumeButton :: VolumeButtonClass o => o -> VolumeButton +toVolumeButton = unsafeCastGObject . toGObject + +instance VolumeButtonClass VolumeButton +instance ScaleButtonClass VolumeButton +instance ButtonClass VolumeButton +instance BinClass VolumeButton +instance ContainerClass VolumeButton +instance WidgetClass VolumeButton +instance ObjectClass VolumeButton +instance GObjectClass VolumeButton where + toGObject = GObject . castForeignPtr . unVolumeButton + unsafeCastGObject = VolumeButton . castForeignPtr . unGObject + +castToVolumeButton :: GObjectClass obj => obj -> VolumeButton +castToVolumeButton = castTo gTypeVolumeButton "VolumeButton" + +gTypeVolumeButton :: GType +gTypeVolumeButton = + {# call fun unsafe gtk_volume_button_get_type #} + +-- ***************************************************************** LinkButton + +{#pointer *LinkButton foreign newtype #} deriving (Eq,Ord) + +mkLinkButton = (LinkButton, objectUnrefFromMainloop) +unLinkButton (LinkButton o) = o + +class ButtonClass o => LinkButtonClass o +toLinkButton :: LinkButtonClass o => o -> LinkButton +toLinkButton = unsafeCastGObject . toGObject + +instance LinkButtonClass LinkButton +instance ButtonClass LinkButton +instance BinClass LinkButton +instance ContainerClass LinkButton +instance WidgetClass LinkButton +instance ObjectClass LinkButton +instance GObjectClass LinkButton where + toGObject = GObject . castForeignPtr . unLinkButton + unsafeCastGObject = LinkButton . castForeignPtr . unGObject + +castToLinkButton :: GObjectClass obj => obj -> LinkButton +castToLinkButton = castTo gTypeLinkButton "LinkButton" + +gTypeLinkButton :: GType +gTypeLinkButton = + {# call fun unsafe gtk_link_button_get_type #} + -- *************************************************************** ToggleButton {#pointer *ToggleButton foreign newtype #} deriving (Eq,Ord) @@ -1988,6 +2579,62 @@ gTypeWindow = {# call fun unsafe gtk_window_get_type #} +-- ****************************************************************** Assistant + +{#pointer *Assistant foreign newtype #} deriving (Eq,Ord) + +mkAssistant = (Assistant, objectUnrefFromMainloop) +unAssistant (Assistant o) = o + +class WindowClass o => AssistantClass o +toAssistant :: AssistantClass o => o -> Assistant +toAssistant = unsafeCastGObject . toGObject + +instance AssistantClass Assistant +instance WindowClass Assistant +instance BinClass Assistant +instance ContainerClass Assistant +instance WidgetClass Assistant +instance ObjectClass Assistant +instance GObjectClass Assistant where + toGObject = GObject . castForeignPtr . unAssistant + unsafeCastGObject = Assistant . castForeignPtr . unGObject + +castToAssistant :: GObjectClass obj => obj -> Assistant +castToAssistant = castTo gTypeAssistant "Assistant" + +gTypeAssistant :: GType +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) @@ -2744,6 +3391,34 @@ gTypeVBox = {# call fun unsafe gtk_vbox_get_type #} +-- ******************************************************** RecentChooserWidget + +{#pointer *RecentChooserWidget foreign newtype #} deriving (Eq,Ord) + +mkRecentChooserWidget = (RecentChooserWidget, objectUnrefFromMainloop) +unRecentChooserWidget (RecentChooserWidget o) = o + +class VBoxClass o => RecentChooserWidgetClass o +toRecentChooserWidget :: RecentChooserWidgetClass o => o -> RecentChooserWidget +toRecentChooserWidget = unsafeCastGObject . toGObject + +instance RecentChooserWidgetClass RecentChooserWidget +instance VBoxClass RecentChooserWidget +instance BoxClass RecentChooserWidget +instance ContainerClass RecentChooserWidget +instance WidgetClass RecentChooserWidget +instance ObjectClass RecentChooserWidget +instance GObjectClass RecentChooserWidget where + toGObject = GObject . castForeignPtr . unRecentChooserWidget + unsafeCastGObject = RecentChooserWidget . castForeignPtr . unGObject + +castToRecentChooserWidget :: GObjectClass obj => obj -> RecentChooserWidget +castToRecentChooserWidget = castTo gTypeRecentChooserWidget "RecentChooserWidget" + +gTypeRecentChooserWidget :: GType +gTypeRecentChooserWidget = + {# call fun unsafe gtk_recent_chooser_widget_get_type #} + -- ************************************************************* ColorSelection {#pointer *ColorSelection foreign newtype #} deriving (Eq,Ord) @@ -2855,6 +3530,34 @@ gTypeHBox = {# call fun unsafe gtk_hbox_get_type #} +-- ******************************************************************** InfoBar + +{#pointer *InfoBar foreign newtype #} deriving (Eq,Ord) + +mkInfoBar = (InfoBar, objectUnrefFromMainloop) +unInfoBar (InfoBar o) = o + +class HBoxClass o => InfoBarClass o +toInfoBar :: InfoBarClass o => o -> InfoBar +toInfoBar = unsafeCastGObject . toGObject + +instance InfoBarClass InfoBar +instance HBoxClass InfoBar +instance BoxClass InfoBar +instance ContainerClass InfoBar +instance WidgetClass InfoBar +instance ObjectClass InfoBar +instance GObjectClass InfoBar where + toGObject = GObject . castForeignPtr . unInfoBar + unsafeCastGObject = InfoBar . castForeignPtr . unGObject + +castToInfoBar :: GObjectClass obj => obj -> InfoBar +castToInfoBar = castTo gTypeInfoBar "InfoBar" + +gTypeInfoBar :: GType +gTypeInfoBar = + {# call fun unsafe gtk_info_bar_get_type #} + -- ********************************************************************** Combo {#pointer *Combo foreign newtype #} deriving (Eq,Ord) @@ -3229,6 +3932,34 @@ gTypeMenu = {# call fun unsafe gtk_menu_get_type #} +-- ********************************************************** RecentChooserMenu + +{#pointer *RecentChooserMenu foreign newtype #} deriving (Eq,Ord) + +mkRecentChooserMenu = (RecentChooserMenu, objectUnrefFromMainloop) +unRecentChooserMenu (RecentChooserMenu o) = o + +class MenuClass o => RecentChooserMenuClass o +toRecentChooserMenu :: RecentChooserMenuClass o => o -> RecentChooserMenu +toRecentChooserMenu = unsafeCastGObject . toGObject + +instance RecentChooserMenuClass RecentChooserMenu +instance MenuClass RecentChooserMenu +instance MenuShellClass RecentChooserMenu +instance ContainerClass RecentChooserMenu +instance WidgetClass RecentChooserMenu +instance ObjectClass RecentChooserMenu +instance GObjectClass RecentChooserMenu where + toGObject = GObject . castForeignPtr . unRecentChooserMenu + unsafeCastGObject = RecentChooserMenu . castForeignPtr . unGObject + +castToRecentChooserMenu :: GObjectClass obj => obj -> RecentChooserMenu +castToRecentChooserMenu = castTo gTypeRecentChooserMenu "RecentChooserMenu" + +gTypeRecentChooserMenu :: GType +gTypeRecentChooserMenu = + {# call fun unsafe gtk_recent_chooser_menu_get_type #} + -- ******************************************************************** MenuBar {#pointer *MenuBar foreign newtype #} deriving (Eq,Ord) @@ -3487,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) @@ -4025,6 +4782,31 @@ gTypeIMMulticontext = {# call fun unsafe gtk_im_multicontext_get_type #} +-- ************************************************************ IMContextSimple + +{#pointer *IMContextSimple foreign newtype #} deriving (Eq,Ord) + +mkIMContextSimple = (IMContextSimple, objectUnrefFromMainloop) +unIMContextSimple (IMContextSimple o) = o + +class IMContextClass o => IMContextSimpleClass o +toIMContextSimple :: IMContextSimpleClass o => o -> IMContextSimple +toIMContextSimple = unsafeCastGObject . toGObject + +instance IMContextSimpleClass IMContextSimple +instance IMContextClass IMContextSimple +instance ObjectClass IMContextSimple +instance GObjectClass IMContextSimple where + toGObject = GObject . castForeignPtr . unIMContextSimple + unsafeCastGObject = IMContextSimple . castForeignPtr . unGObject + +castToIMContextSimple :: GObjectClass obj => obj -> IMContextSimple +castToIMContextSimple = castTo gTypeIMContextSimple "IMContextSimple" + +gTypeIMContextSimple :: GType +gTypeIMContextSimple = + {# call fun unsafe gtk_im_context_simple_get_type #} + -- **************************************************************** ItemFactory {#pointer *ItemFactory foreign newtype #} deriving (Eq,Ord) @@ -4121,6 +4903,31 @@ 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 {#pointer *CellRendererPixbuf foreign newtype #} deriving (Eq,Ord) @@ -4171,6 +4978,58 @@ gTypeCellRendererText = {# call fun unsafe gtk_cell_renderer_text_get_type #} +-- ********************************************************** CellRendererAccel + +{#pointer *CellRendererAccel foreign newtype #} deriving (Eq,Ord) + +mkCellRendererAccel = (CellRendererAccel, objectUnrefFromMainloop) +unCellRendererAccel (CellRendererAccel o) = o + +class CellRendererTextClass o => CellRendererAccelClass o +toCellRendererAccel :: CellRendererAccelClass o => o -> CellRendererAccel +toCellRendererAccel = unsafeCastGObject . toGObject + +instance CellRendererAccelClass CellRendererAccel +instance CellRendererTextClass CellRendererAccel +instance CellRendererClass CellRendererAccel +instance ObjectClass CellRendererAccel +instance GObjectClass CellRendererAccel where + toGObject = GObject . castForeignPtr . unCellRendererAccel + unsafeCastGObject = CellRendererAccel . castForeignPtr . unGObject + +castToCellRendererAccel :: GObjectClass obj => obj -> CellRendererAccel +castToCellRendererAccel = castTo gTypeCellRendererAccel "CellRendererAccel" + +gTypeCellRendererAccel :: GType +gTypeCellRendererAccel = + {# call fun unsafe gtk_cell_renderer_accel_get_type #} + +-- *********************************************************** CellRendererSpin + +{#pointer *CellRendererSpin foreign newtype #} deriving (Eq,Ord) + +mkCellRendererSpin = (CellRendererSpin, objectUnrefFromMainloop) +unCellRendererSpin (CellRendererSpin o) = o + +class CellRendererTextClass o => CellRendererSpinClass o +toCellRendererSpin :: CellRendererSpinClass o => o -> CellRendererSpin +toCellRendererSpin = unsafeCastGObject . toGObject + +instance CellRendererSpinClass CellRendererSpin +instance CellRendererTextClass CellRendererSpin +instance CellRendererClass CellRendererSpin +instance ObjectClass CellRendererSpin +instance GObjectClass CellRendererSpin where + toGObject = GObject . castForeignPtr . unCellRendererSpin + unsafeCastGObject = CellRendererSpin . castForeignPtr . unGObject + +castToCellRendererSpin :: GObjectClass obj => obj -> CellRendererSpin +castToCellRendererSpin = castTo gTypeCellRendererSpin "CellRendererSpin" + +gTypeCellRendererSpin :: GType +gTypeCellRendererSpin = + {# call fun unsafe gtk_cell_renderer_spin_get_type #} + -- ********************************************************** CellRendererCombo {#pointer *CellRendererCombo foreign newtype #} deriving (Eq,Ord) @@ -4689,6 +5548,29 @@ gTypeEntryCompletion = {# call fun unsafe gtk_entry_completion_get_type #} +-- **************************************************************** EntryBuffer + +{#pointer *EntryBuffer foreign newtype #} deriving (Eq,Ord) + +mkEntryBuffer = (EntryBuffer, objectUnrefFromMainloop) +unEntryBuffer (EntryBuffer o) = o + +class GObjectClass o => EntryBufferClass o +toEntryBuffer :: EntryBufferClass o => o -> EntryBuffer +toEntryBuffer = unsafeCastGObject . toGObject + +instance EntryBufferClass EntryBuffer +instance GObjectClass EntryBuffer where + toGObject = GObject . castForeignPtr . unEntryBuffer + unsafeCastGObject = EntryBuffer . castForeignPtr . unGObject + +castToEntryBuffer :: GObjectClass obj => obj -> EntryBuffer +castToEntryBuffer = castTo gTypeEntryBuffer "EntryBuffer" + +gTypeEntryBuffer :: GType +gTypeEntryBuffer = + {# call fun unsafe gtk_entry_buffer_get_type #} + -- ********************************************************************* Action {#pointer *Action foreign newtype #} deriving (Eq,Ord) @@ -4712,6 +5594,30 @@ gTypeAction = {# call fun unsafe gtk_action_get_type #} +-- *************************************************************** RecentAction + +{#pointer *RecentAction foreign newtype #} deriving (Eq,Ord) + +mkRecentAction = (RecentAction, objectUnrefFromMainloop) +unRecentAction (RecentAction o) = o + +class ActionClass o => RecentActionClass o +toRecentAction :: RecentActionClass o => o -> RecentAction +toRecentAction = unsafeCastGObject . toGObject + +instance RecentActionClass RecentAction +instance ActionClass RecentAction +instance GObjectClass RecentAction where + toGObject = GObject . castForeignPtr . unRecentAction + unsafeCastGObject = RecentAction . castForeignPtr . unGObject + +castToRecentAction :: GObjectClass obj => obj -> RecentAction +castToRecentAction = castTo gTypeRecentAction "RecentAction" + +gTypeRecentAction :: GType +gTypeRecentAction = + {# call fun unsafe gtk_recent_action_get_type #} + -- *************************************************************** ToggleAction {#pointer *ToggleAction foreign newtype #} deriving (Eq,Ord) @@ -4829,6 +5735,29 @@ gTypeWindowGroup :: GType gTypeWindowGroup = {# call fun unsafe gtk_window_group_get_type #} + +-- *************************************************************** CellEditable + +{#pointer *CellEditable foreign newtype #} deriving (Eq,Ord) + +mkCellEditable = (CellEditable, objectUnrefFromMainloop) +unCellEditable (CellEditable o) = o + +class GObjectClass o => CellEditableClass o +toCellEditable :: CellEditableClass o => o -> CellEditable +toCellEditable = unsafeCastGObject . toGObject + +instance CellEditableClass CellEditable +instance GObjectClass CellEditable where + toGObject = GObject . castForeignPtr . unCellEditable + unsafeCastGObject = CellEditable . castForeignPtr . unGObject + +castToCellEditable :: GObjectClass obj => obj -> CellEditable +castToCellEditable = castTo gTypeCellEditable "CellEditable" + +gTypeCellEditable :: GType +gTypeCellEditable = + {# call fun unsafe gtk_cell_editable_get_type #} -- ******************************************************************* Editable diff --git a/Graphics/UI/Gtk/Windows/Assistant.chs b/Graphics/UI/Gtk/Windows/Assistant.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Windows/Assistant.chs @@ -0,0 +1,603 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget Assistant +-- +-- Author : Andy Stewart +-- +-- Created: 22 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- A widget used to guide users through multi-step operations +-- +-- * Module available since Gtk+ version 2.10 +-- +module Graphics.UI.Gtk.Windows.Assistant ( + +-- * Detail +-- +-- | A 'Assistant' is a widget used to represent a generally complex operation +-- splitted in several steps, guiding the user through its pages and +-- controlling the page flow to collect the necessary data. + +-- ** GtkAssistant as GtkBuildable +-- +-- | The 'Assistant' implementation of the 'Buildable' interface exposes the +-- @actionArea@ as internal children with the name \"action_area\". +-- +-- To add pages to an assistant in 'Builder', simply add it as a \ to +-- the 'Assistant' object, and set its child properties as necessary. + +-- * Class Hierarchy +-- +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----'Widget' +-- | +----'Container' +-- | +----'Bin' +-- | +----'Window' +-- | +----Assistant +-- @ + +#if GTK_CHECK_VERSION(2,10,0) +-- * Types + Assistant, + AssistantClass, + castToAssistant, + toAssistant, + +-- * Enums. + AssistantPageType(..), + +-- * Constructors + assistantNew, + +-- * Methods + assistantGetNPages, + assistantGetNthPage, + assistantPrependPage, + assistantAppendPage, + assistantInsertPage, + assistantSetForwardPageFunc, + assistantAddActionWidget, + assistantRemoveActionWidget, + assistantUpdateButtonsState, + assistantSetPageType, + assistantGetPageType, + assistantSetPageTitle, + assistantGetPageTitle, + assistantSetPageHeaderImage, + assistantGetPageHeaderImage, + assistantSetPageSideImage, + assistantGetPageSideImage, + assistantSetPageComplete, + assistantGetPageComplete, +#if GTK_CHECK_VERSION(2,22,0) + assistantCommit, +#endif + +-- * Attributes + assistantCurrentPage, + +-- * Child Attributes + assistantChildPageType, + assistantChildTitle, + assistantChildHeaderImage, + assistantChildSidebarImage, + assistantChildComplete, + +-- * Signals + assistantCancel, + assistantPrepare, + assistantApply, + assistantClose, +#endif + ) where + +import Control.Monad (liftM, unless) + +import System.Glib.FFI +import System.Glib.UTFString +import System.Glib.Attributes +import System.Glib.Properties +import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +{#import Graphics.UI.Gtk.Types#} +{#import Graphics.UI.Gtk.Signals#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,10,0) +-------------------- +-- Enum +{#enum GtkAssistantPageType as AssistantPageType {underscoreToCase} deriving (Bounded,Eq,Show)#} + +-------------------- +-- Constructors + +-- | Creates a new 'Assistant'. +-- +-- * Available since Gtk+ version 2.10 +-- +assistantNew :: IO Assistant +assistantNew = + makeNewObject mkAssistant $ + liftM (castPtr :: Ptr Widget -> Ptr Assistant) $ + {# call gtk_assistant_new #} + +-------------------- +-- Methods + +-- | Returns the page number of the current page +-- +-- * Available since Gtk+ version 2.10 +-- +assistantGetCurrentPage :: AssistantClass self => self + -> IO Int -- ^ returns The index (starting from 0) of the current page in the + -- @assistant@, if the @assistant@ has no pages, -1 will be returned +assistantGetCurrentPage self = + liftM fromIntegral $ + {# call gtk_assistant_get_current_page #} + (toAssistant self) + +-- | Switches the page to @pageNum@. Note that this will only be necessary in custom buttons, as the +-- assistant flow can be set with 'assistantSetForwardPageFunc'. +-- +-- * Available since Gtk+ version 2.10 +-- +assistantSetCurrentPage :: AssistantClass self => self + -> Int -- ^ @pageNum@ - index of the page to switch to, starting from 0. If + -- negative, the last page will be used. If greater than the number of + -- pages in the @assistant@, nothing will be done. + -> IO () +assistantSetCurrentPage self pageNum = + {# call gtk_assistant_set_current_page #} + (toAssistant self) + (fromIntegral pageNum) + +-- | Returns the number of pages in the @assistant@ +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantGetNPages :: AssistantClass self => self + -> IO Int -- ^ returns The number of pages in the @assistant@. +assistantGetNPages self = + liftM fromIntegral $ + {# call gtk_assistant_get_n_pages #} + (toAssistant self) + +-- | Returns the child widget contained in page number @pageNum@. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantGetNthPage :: AssistantClass self => self + -> Int -- ^ @pageNum@ - The index of a page in the @assistant@, or -1 + -- to get the last page; + -> IO (Maybe Widget) -- ^ returns The child widget, or 'Nothing' if @pageNum@ is out of bounds. +assistantGetNthPage self pageNum = + maybeNull (makeNewObject mkWidget) $ + {# call gtk_assistant_get_nth_page #} + (toAssistant self) + (fromIntegral pageNum) + +-- | Prepends a page to the @assistant@. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantPrependPage :: (AssistantClass self, WidgetClass page) => self + -> page -- ^ @page@ - a 'Widget' + -> IO Int -- ^ returns the index (starting at 0) of the inserted page +assistantPrependPage self page = + liftM fromIntegral $ + {# call gtk_assistant_prepend_page #} + (toAssistant self) + (toWidget page) + +-- | Appends a page to the @assistant@. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantAppendPage :: (AssistantClass self, WidgetClass page) => self + -> page -- ^ @page@ - a 'Widget' + -> IO Int -- ^ returns the index (starting at 0) of the inserted page +assistantAppendPage self page = + liftM fromIntegral $ + {# call gtk_assistant_append_page #} + (toAssistant self) + (toWidget page) + +-- | Inserts a page in the @assistant@ at a given position. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantInsertPage :: (AssistantClass self, WidgetClass page) => self + -> page -- ^ @page@ - a 'Widget' + -> Int -- ^ @position@ - the index (starting at 0) at which to insert the + -- page, or -1 to append the page to the @assistant@ + -> IO Int -- ^ returns the index (starting from 0) of the inserted page +assistantInsertPage self page position = + liftM fromIntegral $ + {# call gtk_assistant_insert_page #} + (toAssistant self) + (toWidget page) + (fromIntegral position) + +-- | Sets the page forwarding function to be @pageFunc@, this function will be +-- used to determine what will be the next page when the user presses the +-- forward button. Setting @pageFunc@ to 'Nothing' will make the assistant to use the +-- default forward function, which just goes to the next visible page. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantSetForwardPageFunc :: AssistantClass self => self + -> Maybe (Int -> IO Int) -- ^ @pageFunc@ - the 'AssistantPage', or 'Nothing' to use the default one. + -> IO () +assistantSetForwardPageFunc self Nothing = do + {# call gtk_assistant_set_forward_page_func #} + (toAssistant self) + nullFunPtr + (castFunPtrToPtr nullFunPtr) + destroyFunPtr + +assistantSetForwardPageFunc self (Just pageFunc) = do + pfPtr <- mkAssistantPageFunc $ \ c _ -> do + result <- pageFunc (fromIntegral c) + return $ fromIntegral result + {# call gtk_assistant_set_forward_page_func #} + (toAssistant self) + pfPtr + (castFunPtrToPtr pfPtr) + destroyFunPtr + +{#pointer AssistantPageFunc#} + +foreign import ccall "wrapper" mkAssistantPageFunc :: + ({#type glong#} -> Ptr () -> IO {#type glong#}) + -> IO AssistantPageFunc + +-- | Sets the page type for @page@. The page type determines the page behavior +-- in the @assistant@. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantSetPageType :: (AssistantClass self, WidgetClass page) => self + -> page -- ^ @page@ - a page of @assistant@ + -> AssistantPageType -- ^ @type@ - the new type for @page@ + -> IO () +assistantSetPageType self page type_ = + {# call gtk_assistant_set_page_type #} + (toAssistant self) + (toWidget page) + ((fromIntegral . fromEnum) type_) + +-- | Gets the page type of @page@. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantGetPageType :: (AssistantClass self, WidgetClass page) => self + -> page -- ^ @page@ - a page of @assistant@ + -> IO AssistantPageType -- ^ returns the page type of @page@. +assistantGetPageType self page = + liftM (toEnum . fromIntegral) $ + {# call gtk_assistant_get_page_type #} + (toAssistant self) + (toWidget page) + +-- | Sets a title for @page@. The title is displayed in the header area of the +-- assistant when @page@ is the current page. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantSetPageTitle :: (AssistantClass self, WidgetClass page) => self + -> page -- ^ @page@ - a page of @assistant@ + -> String -- ^ @title@ - the new title for @page@ + -> IO () +assistantSetPageTitle self page title = + withUTFString title $ \titlePtr -> + {# call gtk_assistant_set_page_title #} + (toAssistant self) + (toWidget page) + titlePtr + +-- | Gets the title for @page@. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantGetPageTitle :: (AssistantClass self, WidgetClass page) => self + -> page -- ^ @page@ - a page of @assistant@ + -> IO String -- ^ returns the title for @page@. +assistantGetPageTitle self page = + {# call gtk_assistant_get_page_title #} + (toAssistant self) + (toWidget page) + >>= peekUTFString + +-- | Sets a header image for @page@. This image is displayed in the header +-- area of the assistant when @page@ is the current page. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantSetPageHeaderImage :: (AssistantClass self, WidgetClass page) => self + -> page -- ^ @page@ - a page of @assistant@ + -> Pixbuf -- ^ @pixbuf@ - the new header image @page@ + -> IO () +assistantSetPageHeaderImage self page pixbuf = + {# call gtk_assistant_set_page_header_image #} + (toAssistant self) + (toWidget page) + pixbuf + +-- | Gets the header image for @page@. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantGetPageHeaderImage :: (AssistantClass self, WidgetClass page) => self + -> page -- ^ @page@ - a page of @assistant@ + -> IO (Maybe Pixbuf) -- ^ returns the header image for @page@, or 'Nothing' if there's no header image for the page. +assistantGetPageHeaderImage self page = + maybeNull (makeNewGObject mkPixbuf) $ + {# call gtk_assistant_get_page_header_image #} + (toAssistant self) + (toWidget page) + +-- | Sets a header image for @page@. This image is displayed in the side area +-- of the assistant when @page@ is the current page. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantSetPageSideImage :: (AssistantClass self, WidgetClass page) => self + -> page -- ^ @page@ - a page of @assistant@ + -> Pixbuf -- ^ @pixbuf@ - the new header image @page@ + -> IO () +assistantSetPageSideImage self page pixbuf = + {# call gtk_assistant_set_page_side_image #} + (toAssistant self) + (toWidget page) + pixbuf + +-- | Gets the header image for @page@. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantGetPageSideImage :: (AssistantClass self, WidgetClass page) => self + -> page -- ^ @page@ - a page of @assistant@ + -> IO (Maybe Pixbuf) -- ^ returns the side image for @page@, or 'Nothing' if there's no side image for the page. +assistantGetPageSideImage self page = + maybeNull (makeNewGObject mkPixbuf) $ + {# call gtk_assistant_get_page_side_image #} + (toAssistant self) + (toWidget page) + +-- | Sets whether @page@ contents are complete. This will make @assistant@ +-- update the buttons state to be able to continue the task. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantSetPageComplete :: (AssistantClass self, WidgetClass page) => self + -> page -- ^ @page@ - a page of @assistant@ + -> Bool -- ^ @complete@ - the completeness status of the page + -> IO () +assistantSetPageComplete self page complete = + {# call gtk_assistant_set_page_complete #} + (toAssistant self) + (toWidget page) + (fromBool complete) + +-- | Gets whether @page@ is complete. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantGetPageComplete :: (AssistantClass self, WidgetClass page) => self + -> page -- ^ @page@ - a page of @assistant@ + -> IO Bool -- ^ returns @True@ if @page@ is complete. +assistantGetPageComplete self page = + liftM toBool $ + {# call gtk_assistant_get_page_complete #} + (toAssistant self) + (toWidget page) + +#if GTK_CHECK_VERSION(2,22,0) +-- | Erases the visited page history so the back button is not shown on the current page, and removes the +-- cancel button from subsequent pages. +-- +-- Use this when the information provided up to the current page is hereafter deemed permanent and +-- cannot be modified or undone. For example, showing a progress page to track a long-running, +-- unreversible operation after the user has clicked apply on a confirmation page. +-- +-- * Available since Gtk+ version 2.22 +-- +assistantCommit :: AssistantClass self => self -> IO () +assistantCommit self = + {#call gtk_assistant_commit#} (toAssistant self) +#endif + +-- | Adds a widget to the action area of a 'Assistant'. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantAddActionWidget :: (AssistantClass self, WidgetClass child) => self + -> child -- ^ @child@ - a 'Widget' + -> IO () +assistantAddActionWidget self child = + {# call gtk_assistant_add_action_widget #} + (toAssistant self) + (toWidget child) + +-- | Removes a widget from the action area of a 'Assistant'. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantRemoveActionWidget :: (AssistantClass self, WidgetClass child) => self + -> child -- ^ @child@ - a 'Widget' + -> IO () +assistantRemoveActionWidget self child = + {# call gtk_assistant_remove_action_widget #} + (toAssistant self) + (toWidget child) + +-- | Forces @assistant@ to recompute the buttons state. +-- +-- Gtk+ automatically takes care of this in most situations, e.g. when the +-- user goes to a different page, or when the visibility or completeness of a +-- page changes. +-- +-- One situation where it can be necessary to call this function is when +-- changing a value on the current page affects the future page flow of the +-- assistant. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantUpdateButtonsState :: AssistantClass self => self -> IO () +assistantUpdateButtonsState self = + {# call gtk_assistant_update_buttons_state #} + (toAssistant self) + +-------------------- +-- Attributes + +-- | Switches the page to @pageNum@. Note that this will only be necessary in +-- custom buttons, as the @assistant@ flow can be set with +-- 'assistantSetForwardPageFunc'. +-- +-- Returns the page number of the current page +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantCurrentPage :: AssistantClass self => Attr self Int +assistantCurrentPage = newAttr + assistantGetCurrentPage + assistantSetCurrentPage + +-------------------- +-- Child Attributes + +-- | The type of the assistant page. +-- +-- Default value: 'AssistantPageContent' +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantChildPageType :: AssistantClass self => Attr self AssistantPageType +assistantChildPageType = + newAttrFromEnumProperty "page-type" {#call pure unsafe assistant_page_type_get_type#} + +-- | The title that is displayed in the page header. +-- +-- If title and header-image are both, no header is displayed. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantChildTitle :: AssistantClass self => Attr self String +assistantChildTitle = newAttrFromStringProperty "title" + +-- | The image that is displayed next to the page. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantChildHeaderImage :: AssistantClass self => Attr self Pixbuf +assistantChildHeaderImage = newAttrFromObjectProperty "header-image" + {# call pure unsafe gdk_pixbuf_get_type #} + +-- | Sidebar image for the assistant page. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantChildSidebarImage :: AssistantClass self => Attr self Pixbuf +assistantChildSidebarImage = newAttrFromObjectProperty "sidebar-image" + {# call pure unsafe gdk_pixbuf_get_type #} + +-- | Setting the \"complete\" child property to @True@ marks a page as +-- complete (i.e.: all the required fields are filled out). Gtk+ uses this +-- information to control the sensitivity of the navigation buttons. +-- +-- Default value: @False@ +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantChildComplete :: AssistantClass self => Attr self Bool +assistantChildComplete = newAttrFromBoolProperty "complete" + +-------------------- +-- Signals + +-- | The ::assistantCancel signal is emitted when then the assistantCancel button is clicked. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantCancel :: AssistantClass self => Signal self (IO ()) +assistantCancel = Signal (connect_NONE__NONE "cancel") + +-- | The ::assistantPrepare signal is emitted when a new page is set as the assistant's +-- current page, before making the new page visible. A handler for this signal +-- can do any preparation which are necessary before showing @page@. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantPrepare :: AssistantClass self => Signal self (Widget -> IO ()) +assistantPrepare = Signal (connect_OBJECT__NONE "prepare") + +-- | The ::assistantApply signal is emitted when the assistantApply button is clicked. The +-- default behavior of the 'Assistant' is to switch to the page after the +-- current page, unless the current page is the last one. +-- +-- A handler for the ::assistantApply signal should carry out the actions for which +-- the wizard has collected data. If the action takes a long time to complete, +-- you might consider to put a page of type 'AssistantPageProgress' after the +-- confirmation page and handle this operation within the 'assistantPrepare' signal of the progress page. +-- +-- +-- * Available since Gtk+ version 2.10 +-- +assistantApply :: AssistantClass self => Signal self (IO ()) +assistantApply = Signal (connect_NONE__NONE "apply") + +-- | The ::assistantClose signal is emitted either when the assistantClose button of a summary +-- page is clicked, or when the apply button in the last page in the flow (of +-- type 'AssistantPageConfirm') is clicked. +-- +assistantClose :: AssistantClass self => Signal self (IO ()) +assistantClose = Signal (connect_NONE__NONE "close") +#endif diff --git a/Graphics/UI/Gtk/Windows/Dialog.chs b/Graphics/UI/Gtk/Windows/Dialog.chs --- a/Graphics/UI/Gtk/Windows/Dialog.chs +++ b/Graphics/UI/Gtk/Windows/Dialog.chs @@ -7,7 +7,7 @@ -- Created: 23 May 2001 -- -- Copyright (C) 1999-2005 Axel Simon --- Copyright (C) 2009 Andy Stewart +-- Copyright (C) 2009-2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public @@ -100,6 +100,9 @@ castToDialog, gTypeDialog, toDialog, +-- * Enums + ResponseId(..), + -- * Constructors dialogNew, @@ -108,7 +111,6 @@ dialogGetActionArea, dialogRun, dialogResponse, - ResponseId(..), dialogAddButton, dialogAddActionWidget, dialogGetHasSeparator, @@ -118,6 +120,9 @@ dialogGetResponseForWidget, dialogAlternativeDialogButtonOrder, dialogSetAlternativeButtonOrderFromArray, +#if GTK_CHECK_VERSION(2,20,0) + dialogGetWidgetForResponse, +#endif -- * Attributes dialogHasSeparator, @@ -340,6 +345,18 @@ (toDialog self) (fromIntegral (length newOrder)) newOrderPtr + +#if GTK_CHECK_VERSION(2,20,0) +-- | Gets the widget button that uses the given response ID in the action area of a dialog. +dialogGetWidgetForResponse :: DialogClass self => self + -> ResponseId -- ^ @responseId@ the response ID used by the dialog widget + -> IO (Maybe Widget) -- ^ returns the widget button that uses the given @responseId@, or 'Nothing'. +dialogGetWidgetForResponse self responseId = + maybeNull (makeNewObject mkWidget) $ + {#call gtk_dialog_get_widget_for_response #} + (toDialog self) + (fromResponse responseId) +#endif -------------------- -- Attributes diff --git a/Graphics/UI/Gtk/Windows/MessageDialog.chs b/Graphics/UI/Gtk/Windows/MessageDialog.chs --- a/Graphics/UI/Gtk/Windows/MessageDialog.chs +++ b/Graphics/UI/Gtk/Windows/MessageDialog.chs @@ -89,6 +89,9 @@ messageDialogImage, #endif messageDialogButtons, +#if GTK_CHECK_VERSION(2,22,0) + messageDialogMessageArea, +#endif ) where import Control.Monad (liftM) @@ -333,6 +336,16 @@ messageDialogButtons :: MessageDialogClass self => WriteAttr self ButtonsType messageDialogButtons = writeAttrFromEnumProperty "buttons" {#call pure unsafe gtk_buttons_type_get_type #} + +#if GTK_CHECK_VERSION(2,22,0) +-- | The 'VBox' that corresponds to the message area of this dialog. +-- +-- * Available since Gtk+ version 2.22 +-- +messageDialogMessageArea :: MessageDialogClass self => ReadAttr self VBox +messageDialogMessageArea = readAttrFromObjectProperty "message-area" + {# call pure unsafe gtk_vbox_get_type #} +#endif -------------------- -- helpers diff --git a/Graphics/UI/Gtk/Windows/OffscreenWindow.chs b/Graphics/UI/Gtk/Windows/OffscreenWindow.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Windows/OffscreenWindow.chs @@ -0,0 +1,123 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GIMP Toolkit (GTK) Widget OffscreenWindow +-- +-- Author : Andy Stewart +-- +-- Created: 25 Mar 2010 +-- +-- Copyright (C) 2010 Andy Stewart +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- A toplevel container widget used to manage offscreen rendering of child widgets. +-- +-- * Module available since Gtk+ version 2.20 +-- +module Graphics.UI.Gtk.Windows.OffscreenWindow ( +-- * Detail +-- | 'OffscreenWindow' is strictly intended to be used for obtaining snapshots of widgets that are not +-- part of a normal widget hierarchy. It differs from 'widgetGetSnapshot' in that the widget you +-- want to get a snapshot of need not be displayed on the user's screen as a part of a widget +-- hierarchy. However, since 'OffscreenWindow' is a toplevel widget you cannot obtain snapshots of a +-- full window with it since you cannot pack a toplevel widget in another toplevel. +-- +-- The idea is to take a widget and manually set the state of it, add it to a 'OffscreenWindow' and +-- then retrieve the snapshot as a 'Pixmap' or 'Pixbuf'. +-- +-- 'OffscreenWindow' derives from 'Window' only as an implementation detail. Applications should not +-- use any API specific to 'Window' to operate on this object. It should be treated as a 'Bin' that +-- has no parent widget. +-- +-- When contained offscreen widgets are redrawn, 'OffscreenWindow' will emit a 'damageEvent' signal. + +-- * Class Hierarchy +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----'Widget' +-- | +----'Container' +-- | +----'Bin' +-- | +----Window +-- | +----'OffscreenWindow' +-- @ + +#if GTK_CHECK_VERSION(2,20,0) +-- * Types + OffscreenWindow, + OffscreenWindowClass, + castToOffscreenWindow, gTypeOffscreenWindow, + toOffscreenWindow, + +-- * Constructors + offscreenWindowNew, + +-- * Methods + offscreenWindowGetPixmap, + offscreenWindowGetPixbuf, +#endif +) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.Attributes +import System.Glib.Properties +import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +{#import Graphics.UI.Gtk.Types#} + +{# context lib="gtk" prefix="gtk" #} + +#if GTK_CHECK_VERSION(2,20,0) +-- | Creates a toplevel container widget that is used to retrieve snapshots of widgets without showing +-- them on the screen. For widgets that are on the screen and part of a normal widget hierarchy, +-- 'widgetGetSnapshot' can be used instead. +-- +-- * Available since Gtk+ version 2.20 +-- +offscreenWindowNew :: IO OffscreenWindow +offscreenWindowNew = + makeNewObject mkOffscreenWindow $ + liftM (castPtr :: Ptr Widget -> Ptr OffscreenWindow) $ + {#call gtk_offscreen_window_new #} + +-- | Retrieves a snapshot of the contained widget in the form of a 'Pixmap'. If you need to keep this +-- around over window resizes then you should add a reference to it. +-- +-- * Available since Gtk+ version 2.20 +-- +offscreenWindowGetPixmap :: OffscreenWindowClass self + => self -- ^ @offscreen@ the 'OffscreenWindow' contained widget. + -> IO (Maybe Pixmap) -- ^ returns A 'Pixmap' pointer to the offscreen pixmap, or 'Nothing'. +offscreenWindowGetPixmap offscreen = + maybeNull (makeNewGObject mkPixmap) $ + {#call gtk_offscreen_window_get_pixmap #} + (toOffscreenWindow offscreen) + +-- | Retrieves a snapshot of the contained widget in the form of a 'Pixbuf'. +-- +-- * Available since Gtk+ version 2.20 +-- +offscreenWindowGetPixbuf :: OffscreenWindowClass self + => self -- ^ @offscreen@ the 'OffscreenWindow' contained widget. + -> IO (Maybe Pixbuf) -- ^ returns A 'Pixbuf' pointer to the offscreen pixbuf, or 'Nothing'. +offscreenWindowGetPixbuf offscreen = + maybeNull (wrapNewGObject mkPixbuf) $ + {#call gtk_offscreen_window_get_pixbuf #} + (toOffscreenWindow offscreen) + +#endif diff --git a/Graphics/UI/Gtk/Windows/Window.chs b/Graphics/UI/Gtk/Windows/Window.chs --- a/Graphics/UI/Gtk/Windows/Window.chs +++ b/Graphics/UI/Gtk/Windows/Window.chs @@ -139,6 +139,9 @@ #if GTK_CHECK_VERSION(2,10,0) windowGetGroup, #endif +#if GTK_CHECK_VERSION(2,20,0) + windowGetWindowType, +#endif -- * Attributes windowTitle, @@ -188,6 +191,9 @@ windowHasFrame, windowIconList, windowMnemonicModifier, +#if GTK_CHECK_VERSION(2,20,0) + windowMnemonicVisible, +#endif -- * Signals frameEvent, @@ -1923,6 +1929,19 @@ {# call window_get_group #} (maybe (Window nullForeignPtr) toWindow self) #endif +#if GTK_CHECK_VERSION(2,20,0) +-- | Gets the type of the window. See 'WindowType'. +-- +-- * Available since Gtk version 2.20 +-- +windowGetWindowType :: WindowClass self => self + -> IO WindowType -- ^ returns the type of the window +windowGetWindowType self = + liftM (toEnum . fromIntegral) $ + {#call gtk_window_get_window_type #} + (toWindow self) +#endif + -------------------- -- Attributes @@ -2047,6 +2066,11 @@ windowMnemonicModifier = newAttr windowGetMnemonicModifier windowSetMnemonicModifier + +#if GTK_CHECK_VERSION(2,20,0) +windowMnemonicVisible :: WindowClass self => Attr self Bool +windowMnemonicVisible = newAttrFromBoolProperty "mnemonics-visible" +#endif -- | Unique identifier for the window to be used when restoring a session. -- diff --git a/Graphics/UI/Gtk/Windows/WindowGroup.chs b/Graphics/UI/Gtk/Windows/WindowGroup.chs --- a/Graphics/UI/Gtk/Windows/WindowGroup.chs +++ b/Graphics/UI/Gtk/Windows/WindowGroup.chs @@ -52,7 +52,7 @@ ) where import System.Glib.FFI -import System.Glib.GObject (constructNewGObject) +import System.Glib.GObject (wrapNewGObject) import System.Glib.GList (fromGList) {#import Graphics.UI.Gtk.Types#} @@ -67,7 +67,7 @@ -- windowGroupNew :: IO WindowGroup windowGroupNew = - constructNewGObject mkWindowGroup $ + wrapNewGObject mkWindowGroup $ {# call gtk_window_group_new #} -------------------- diff --git a/Gtk2HsSetup.hs b/Gtk2HsSetup.hs --- a/Gtk2HsSetup.hs +++ b/Gtk2HsSetup.hs @@ -23,16 +23,24 @@ CABAL_VERSION_MICRO) #else #warning Setup.hs is guessing the version of Cabal. If compilation of Setup.hs fails use -DCABAL_VERSION_MINOR=x for Cabal version 1.x.0 when building (prefixed by --ghc-option= when using the 'cabal' command) +#if (__GLASGOW_HASKELL__ >= 700) +#define CABAL_VERSION CABAL_VERSION_ENCODE(1,10,0) +#else #if (__GLASGOW_HASKELL__ >= 612) #define CABAL_VERSION CABAL_VERSION_ENCODE(1,8,0) #else #define CABAL_VERSION CABAL_VERSION_ENCODE(1,6,0) #endif #endif +#endif -- | Build a Gtk2hs package. -- -module Gtk2HsSetup ( gtk2hsUserHooks, getPkgConfigPackages ) where +module Gtk2HsSetup ( + gtk2hsUserHooks, + getPkgConfigPackages, + checkGtk2hsBuildtools + ) where import Distribution.Simple import Distribution.Simple.PreProcess @@ -65,7 +73,7 @@ import Distribution.Simple.Compiler ( Compiler(..) ) import Distribution.Simple.Program ( Program(..), ConfiguredProgram(..), - rawSystemProgramConf, rawSystemProgramStdoutConf, + rawSystemProgramConf, rawSystemProgramStdoutConf, programName, c2hsProgram, pkgConfigProgram, requireProgram, ghcPkgProgram, simpleProgram, lookupProgram, rawSystemProgramStdout, ProgArg) import Distribution.ModuleName ( ModuleName, components, toFilePath ) @@ -83,10 +91,11 @@ #endif import Distribution.Text ( simpleParse, display ) import System.FilePath -import System.Directory ( doesFileExist ) +import System.Exit (exitFailure) +import System.Directory ( doesFileExist, getDirectoryContents, doesDirectoryExist ) import Distribution.Version (Version(..)) import Distribution.Verbosity -import Control.Monad (when, unless, filterM) +import Control.Monad (when, unless, filterM, liftM, forM, forM_) import Data.Maybe ( isJust, isNothing, fromMaybe, maybeToList ) import Data.List (isPrefixOf, isSuffixOf, nub) import Data.Char (isAlpha) @@ -94,7 +103,6 @@ import qualified Data.Set as S import Control.Applicative ((<$>)) -import System.Directory (getDirectoryContents, doesDirectoryExist) -- the name of the c2hs pre-compiled header file precompFile = "precompchs.bin" @@ -103,13 +111,13 @@ hookedPrograms = [typeGenProgram, signalGenProgram, c2hsLocal], hookedPreProcessors = [("chs", ourC2hs)], confHook = \pd cf -> - confHook simpleUserHooks pd cf >>= return . adjustLocalBuildInfo, + (fmap adjustLocalBuildInfo (confHook simpleUserHooks pd cf)), postConf = \args cf pd lbi -> do genSynthezisedFiles (fromFlag (configVerbosity cf)) pd lbi postConf simpleUserHooks args cf pd lbi, buildHook = \pd lbi uh bf -> fixDeps pd >>= \pd -> - (buildHook simpleUserHooks) pd lbi uh bf, - copyHook = \pd lbi uh flags -> (copyHook simpleUserHooks) pd lbi uh flags >> + buildHook simpleUserHooks pd lbi uh bf, + copyHook = \pd lbi uh flags -> copyHook simpleUserHooks pd lbi uh flags >> installCHI pd lbi (fromFlag (copyVerbosity flags)) (fromFlag (copyDest flags)), instHook = \pd lbi uh flags -> #if defined(mingw32_HOST_OS) || defined(__MINGW32__) @@ -187,7 +195,11 @@ _ | modeGenerateRegFile -> die "Generate Reg File not supported" | modeGenerateRegScript -> die "Generate Reg Script not supported" | otherwise -> registerPackage verbosity +#if CABAL_VERSION_CHECK(1,10,0) + installedPkgInfo pkg lbi inplace [packageDb] +#else installedPkgInfo pkg lbi inplace packageDb +#endif where modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags)) @@ -298,7 +310,7 @@ getCppOptions bi lbi = nub $ ["-I" ++ dir | dir <- PD.includeDirs bi] - ++ [opt | opt@('-':c:_) <- (PD.cppOptions bi ++ PD.ccOptions bi), c `elem` "DIU"] + ++ [opt | opt@('-':c:_) <- PD.cppOptions bi ++ PD.ccOptions bi, c `elem` "DIU"] installCHI :: PackageDescription -- ^information from the .cabal file -> LocalBuildInfo -- ^information from the configure step @@ -308,14 +320,13 @@ let InstallDirs { libdir = libPref } = absoluteInstallDirs pkg lbi copydest -- cannot use the recommended 'findModuleFiles' since it fails if there exists -- a modules that does not have a .chi file - mFiles <- mapM (findFileWithExtension' ["chi"] [buildDir lbi]) - (map toFilePath + mFiles <- mapM (findFileWithExtension' ["chi"] [buildDir lbi] . toFilePath) #if CABAL_VERSION_CHECK(1,8,0) (PD.libModules lib) #else (PD.libModules pkg) #endif - ) + let files = [ f | Just f <- mFiles ] #if CABAL_VERSION_CHECK(1,8,0) installOrdinaryFiles verbosity libPref files @@ -331,13 +342,13 @@ ------------------------------------------------------------------------------ typeGenProgram :: Program -typeGenProgram = (simpleProgram "gtk2hsTypeGen") +typeGenProgram = simpleProgram "gtk2hsTypeGen" signalGenProgram :: Program -signalGenProgram = (simpleProgram "gtk2hsHookGenerator") +signalGenProgram = simpleProgram "gtk2hsHookGenerator" c2hsLocal :: Program -c2hsLocal = (simpleProgram "gtk2hsC2hs") +c2hsLocal = simpleProgram "gtk2hsC2hs" genSynthezisedFiles :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () genSynthezisedFiles verb pd lbi = do @@ -370,7 +381,7 @@ res <- rawSystemProgramStdoutConf verb prog (withPrograms lbi) args rewriteFile outFile res - (flip mapM_) (filter (\(tag,_) -> "x-types-" `isPrefixOf` tag && "file" `isSuffixOf` tag) xList) $ + forM_ (filter (\(tag,_) -> "x-types-" `isPrefixOf` tag && "file" `isSuffixOf` tag) xList) $ \(fileTag, f) -> do let tag = reverse (drop 4 (reverse fileTag)) info verb ("Ensuring that class hierarchy in "++f++" is up-to-date.") @@ -391,7 +402,7 @@ sequence [ do version <- pkgconfig ["--modversion", display pkgname] case simpleParse version of - Nothing -> die $ "parsing output of pkg-config --modversion failed" + Nothing -> die "parsing output of pkg-config --modversion failed" Just v -> return (PackageIdentifier pkgname v) | Dependency pkgname _ <- concatMap pkgconfigDepends (allBuildInfo pkg) ] where @@ -456,9 +467,9 @@ extractDeps :: ModDep -> IO ModDep extractDeps md@ModDep { mdLocation = Nothing } = return md extractDeps md@ModDep { mdLocation = Just f } = withUTF8FileContents f $ \con -> do - let findImports acc (('{':'#':xs):xxs) = case (dropWhile ((==) ' ') xs) of + let findImports acc (('{':'#':xs):xxs) = case (dropWhile (' ' ==) xs) of ('i':'m':'p':'o':'r':'t':' ':ys) -> - case simpleParse (takeWhile ((/=) '#') ys) of + case simpleParse (takeWhile ('#' /=) ys) of Just m -> findImports (m:acc) xxs Nothing -> die ("cannot parse chs import in "++f++":\n"++ "offending line is {#"++xs) @@ -484,3 +495,17 @@ Just md -> (md:out', visited') where (out',visited') = foldl visit (out, m `S.insert` visited) (mdRequires md) + +-- Check user whether install gtk2hs-buildtools correctly. +checkGtk2hsBuildtools :: [String] -> IO () +checkGtk2hsBuildtools programs = do + programInfos <- mapM (\ name -> do + location <- programFindLocation (simpleProgram name) normal + return (name, location) + ) programs + let printError name = do + putStrLn $ "Cannot find " ++ name ++ "\n" + ++ "Please install `gtk2hs-buildtools` first and check that the install directory is in your PATH (e.g. HOME/.cabal/bin)." + exitFailure + forM_ programInfos $ \ (name, location) -> + when (isNothing location) (printError name) diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,7 +1,10 @@ -- Setup file for a Gtk2Hs module. Contains only adjustments specific to this module, -- all Gtk2Hs-specific boilerplate is stored in Gtk2HsSetup.hs which should be kept -- identical across all modules. -import Gtk2HsSetup ( gtk2hsUserHooks ) +import Gtk2HsSetup ( gtk2hsUserHooks, checkGtk2hsBuildtools ) import Distribution.Simple ( defaultMainWithHooks ) -main = defaultMainWithHooks gtk2hsUserHooks +main = do + checkGtk2hsBuildtools ["gtk2hsC2hs", "gtk2hsTypeGen", "gtk2hsHookGenerator"] + defaultMainWithHooks gtk2hsUserHooks + diff --git a/demo/actionMenu/ActionMenu.hs b/demo/actionMenu/ActionMenu.hs --- a/demo/actionMenu/ActionMenu.hs +++ b/demo/actionMenu/ActionMenu.hs @@ -45,43 +45,43 @@ -- Create menu items newAct <- actionNew "NewAction" "New" - (Just "Clear the spreadsheet area.") - (Just stockNew) + (Just "Clear the spreadsheet area.") + (Just stockNew) newAct `onActionActivate` putStrLn "New activated." openAct <- actionNew "OpenAction" "Open" - (Just "Open an existing spreadsheet.") - (Just stockOpen) + (Just "Open an existing spreadsheet.") + (Just stockOpen) openAct `onActionActivate` putStrLn "Open activated." saveAct <- actionNew "SaveAction" "Save" - (Just "Save the current spreadsheet.") - (Just stockSave) + (Just "Save the current spreadsheet.") + (Just stockSave) saveAct `onActionActivate` putStrLn "Save activated." saveAsAct <- actionNew "SaveAsAction" "SaveAs" - (Just "Save spreadsheet under new name.") - (Just stockSaveAs) + (Just "Save spreadsheet under new name.") + (Just stockSaveAs) saveAsAct `onActionActivate` putStrLn "SaveAs activated." exitAct <- actionNew "ExitAction" "Exit" - (Just "Exit this application.") - (Just stockSaveAs) - exitAct `onActionActivate` mainQuit + (Just "Exit this application.") + (Just stockSaveAs) + exitAct `onActionActivate` mainQuit cutAct <- actionNew "CutAction" "Cut" - (Just "Cut out the current selection.") - (Just stockCut) + (Just "Cut out the current selection.") + (Just stockCut) cutAct `onActionActivate` putStrLn "Cut activated." copyAct <- actionNew "CopyAction" "Copy" - (Just "Copy the current selection.") - (Just stockCopy) + (Just "Copy the current selection.") + (Just stockCopy) copyAct `onActionActivate` putStrLn "Copy activated." pasteAct <- actionNew "PasteAction" "Paste" - (Just "Paste the current selection.") - (Just stockPaste) + (Just "Paste the current selection.") + (Just stockPaste) pasteAct `onActionActivate` putStrLn "Paste activated." - + standardGroup <- actionGroupNew "standard" mapM_ (actionGroupAddAction standardGroup) [fileAct, editAct] mapM_ (\act -> actionGroupAddActionWithAccel standardGroup act Nothing) [newAct, openAct, saveAct, saveAsAct, exitAct, cutAct, copyAct, pasteAct] - + ui <- uiManagerNew mid <- uiManagerAddUiFromString ui uiDef uiManagerInsertActionGroup ui standardGroup 0 @@ -91,8 +91,8 @@ win `onSizeRequest` return (Requisition 200 100) (Just menuBar) <- uiManagerGetWidget ui "/ui/menubar" (Just toolBar) <- uiManagerGetWidget ui "/ui/toolbar" - - edit <- textViewNew + + edit <- textViewNew vBox <- vBoxNew False 0 set vBox [boxHomogeneous := False] boxPackStart vBox menuBar PackNatural 0 diff --git a/demo/buttonbox/ButtonBox.hs b/demo/buttonbox/ButtonBox.hs --- a/demo/buttonbox/ButtonBox.hs +++ b/demo/buttonbox/ButtonBox.hs @@ -16,7 +16,7 @@ -- Sets the border width of the window. set window [ containerBorderWidth := 10 ] - + hbuttonbox <- hButtonBoxNew set window [ containerChild := hbuttonbox ] @@ -28,7 +28,7 @@ -- Add each button to the button box with the default packing and padding set hbuttonbox [ containerChild := button | button <- [button1, button2, button3] ] - + -- This sets button3 to be a so called 'secondary child'. When the layout -- stlye is ButtonboxStart or ButtonboxEnd, the secondary children are -- grouped seperately from the others. Resize the window to see the effect. @@ -37,7 +37,7 @@ -- Note that the child attribute 'buttonBoxChildSecondary' takes the -- button box container child 'button3' as a parameter. set hbuttonbox [ buttonBoxLayoutStyle := ButtonboxStart - , buttonBoxChildSecondary button3 := True ] + , buttonBoxChildSecondary button3 := True ] -- The final step is to display everything (the window and all the widgets -- contained within it) @@ -46,4 +46,3 @@ -- All Gtk+ applications must run the main event loop. Control ends here and -- waits for an event to occur (like a key press or mouse event). mainGUI - diff --git a/demo/carsim/CarSim.hs b/demo/carsim/CarSim.hs --- a/demo/carsim/CarSim.hs +++ b/demo/carsim/CarSim.hs @@ -184,7 +184,7 @@ containerAdd bb qa containerAdd bb qq return bb - + howMany <- do sc <- vScaleNewWithRange 1 40 1 @@ -203,7 +203,7 @@ alignmentSetPadding al 15 15 15 15 containerAdd al sc return al - + track <- do let dr = drawingArea @@ -236,7 +236,7 @@ frameSetShadowType af ShadowNone containerAdd af dr return af - + -- 'layout' is a widget that contains all interface elements -- properly arranged. diff --git a/demo/embedded/Embedded.hs b/demo/embedded/Embedded.hs --- a/demo/embedded/Embedded.hs +++ b/demo/embedded/Embedded.hs @@ -1,7 +1,7 @@ -- Use GtkSocket and GtkPlug for cross-process embedded. -- Just startup program, press 'm' to create tab with new button. --- Click button for hang to simulate plug hanging process, --- but socket process still running, can switch to other tab. +-- Click button for hang to simulate plug hanging process, +-- but socket process still running, can switch to other tab. module Main where @@ -27,10 +27,10 @@ -- Entry plug main when have two arguments. [id] -> plugMain (toNativeWindowId $ read id :: NativeWindowId) -- get GtkSocket id -- Othersise entry socket main when no arguments. - _ -> socketMain - + _ -> socketMain + -- | GtkSocekt main. -socketMain :: IO () +socketMain :: IO () socketMain = do initGUI @@ -48,7 +48,7 @@ -- Handle key press. window `on` keyPressEvent $ tryEvent $ do keyName <- eventKeyName - liftIO $ + liftIO $ case keyName of "m" -> do -- Create new GtkSocket. @@ -57,9 +57,9 @@ notebookAppendPage notebook socket "Tab" -- add to GtkSocekt notebook id <- socketGetId socket -- get GtkSocket id - -- Fork process to add GtkPlug into GtkSocekt. + -- Fork process to add GtkPlug into GtkSocekt. path <- liftM2 () getCurrentDirectory getProgName -- get program full path - runCommand $ path ++ " " ++ (show $ fromNativeWindowId id) -- don't use `forkProcess` + runCommand $ path ++ " " ++ (show $ fromNativeWindowId id) -- don't use `forkProcess` return () "q" -> mainQuit -- quit @@ -74,13 +74,13 @@ plug <- plugNew $ Just id plug `onDestroy` mainQuit - + button <- buttonNewWithLabel "Click me to hang." plug `containerAdd` button -- Simulate a plugin hanging to see if it blocks the outer process. button `onClicked` threadDelay 5000000 - + widgetShowAll plug - + mainGUI diff --git a/demo/embedded/MPlayer.hs b/demo/embedded/MPlayer.hs new file mode 100644 --- /dev/null +++ b/demo/embedded/MPlayer.hs @@ -0,0 +1,78 @@ +-- | MPlayer client demo +-- Author : Andy Stewart +-- Copyright : (c) 2010 Andy Stewart + +module Main where + +import Control.Applicative +import Control.Concurrent +import Control.Concurrent.STM +import Control.Monad +import Control.Monad.Trans +import Graphics.UI.Gtk +import System.Exit +import System.IO +import System.Process +import System.Environment +import Text.Printf + +main :: IO () +main = do + args <- getArgs + case args of + [filepath] -> do + initGUI + + mainWindow <- windowNew + windowSetDefaultSize mainWindow 800 450 + windowSetPosition mainWindow WinPosCenter + + mplayer <- mplayerNew + mplayerStick mplayer (toContainer mainWindow) + + mainWindow `afterShow` do + mplayerRun mplayer filepath + + mainWindow `onDestroy` do + mplayerQuit mplayer + mainQuit + + return () + + widgetShowAll mainWindow + + mainGUI + _ -> putStrLn "Usage : mplayer file" + +data MPlayer = + MPlayer {mplayerWidget :: DrawingArea + ,mplayerHandle :: TVar (Maybe (Handle, Handle, Handle, ProcessHandle))} + +mplayerNew :: IO MPlayer +mplayerNew = + MPlayer <$> drawingAreaNew + <*> newTVarIO Nothing + +mplayerStick :: MPlayer -> Container -> IO () +mplayerStick (MPlayer {mplayerWidget = mWidget}) container = do + widgetShowAll mWidget + container `containerAdd` mWidget + +mplayerRun :: MPlayer -> FilePath -> IO () +mplayerRun (MPlayer {mplayerWidget = mWidget + ,mplayerHandle = mHandle}) filepath = do + drawWindow <- widgetGetDrawWindow mWidget -- you just can get DrawWindow after widget realized + wid <- liftM fromNativeWindowId $ drawableGetID drawWindow + handle <- runInteractiveCommand $ printf "mplayer %s -slave -wid %d" filepath (wid :: Int) + writeTVarIO mHandle (Just handle) + +mplayerQuit :: MPlayer -> IO () +mplayerQuit MPlayer {mplayerHandle = mHandle} = do + handle <- readTVarIO mHandle + case handle of + Just (inp, _, _, _) -> hPutStrLn inp "quit" + Nothing -> return () + +-- | The IO version of `writeTVar`. +writeTVarIO :: TVar a -> a -> IO () +writeTVarIO a b = atomically $ writeTVar a b diff --git a/demo/embedded/Uzbl.hs b/demo/embedded/Uzbl.hs --- a/demo/embedded/Uzbl.hs +++ b/demo/embedded/Uzbl.hs @@ -1,9 +1,9 @@ -- | This is program use uzbl embedded in window to render webpage. --- Just simple model demo for view, haven't handle event or else. +-- Just simple model demo for view, haven't handle event or else. -- -- You need install uzbl (git clone git://github.com/Dieterbe/uzbl.git) first. --- --- How to use: +-- +-- How to use: -- ./Uzbl default open Google page. -- ./Uzbl url will open url you input -- @@ -11,13 +11,13 @@ import Graphics.UI.Gtk import System.Process -import System.Environment +import System.Environment main :: IO () main = do -- Init. initGUI - + -- Get program arguments. args <- getArgs let url = case args of @@ -29,7 +29,7 @@ windowSetDefaultSize window 900 600 windowSetPosition window WinPosCenter windowSetOpacity window 0.8 -- this function need window-manager support Alpha channel in X11 - + -- Create socket. socket <- socketNew widgetShow socket -- must show before add to parent diff --git a/demo/fastdraw/FastDraw.hs b/demo/fastdraw/FastDraw.hs --- a/demo/fastdraw/FastDraw.hs +++ b/demo/fastdraw/FastDraw.hs @@ -9,7 +9,7 @@ import Data.IORef import Control.Monad ( when ) import Control.Monad.Trans ( liftIO ) -import Data.Array.Base ( unsafeWrite ) +import Data.Array.Base ( unsafeWrite ) main = do @@ -27,7 +27,7 @@ chan <- pixbufGetNChannels pb bits <- pixbufGetBitsPerSample pb putStrLn ("bytes per row: "++show row++", channels per pixel: "++show chan++ - ", bits per sample: "++show bits) + ", bits per sample: "++show bits) -- draw into the Pixbuf doFromTo 0 255 $ \y -> @@ -38,34 +38,34 @@ -- a function to update the Pixbuf blueRef <- newIORef 0 - dirRef <- newIORef True + dirRef <- newIORef True let updateBlue = do blue <- readIORef blueRef - --print blue - doFromTo 0 255 $ \y -> + --print blue + doFromTo 0 255 $ \y -> doFromTo 0 255 $ \x -> - -- Here, writeArray was replaced with unsafeWrite. The latter does - -- not check that the index is within bounds which has a tremendous - -- effect on performance. + -- Here, writeArray was replaced with unsafeWrite. The latter does + -- not check that the index is within bounds which has a tremendous + -- effect on performance. -- writeArray pbData (2+x*chan+y*row) blue -- safe checked indexing unsafeWrite pbData (2+x*chan+y*row) blue -- unchecked indexing -- arrange for the canvas to be redrawn now that we've changed -- the Pixbuf - widgetQueueDraw canvas + widgetQueueDraw canvas -- update the blue state ready for next time dir <- readIORef dirRef - let diff = 4 - let blue' = if dir then blue+diff else blue-diff - if dir then - if blue<=maxBound-diff then writeIORef blueRef blue' else - writeIORef blueRef maxBound >> modifyIORef dirRef not - else - if blue>=minBound+diff then writeIORef blueRef blue' else - writeIORef blueRef minBound >> modifyIORef dirRef not - return True - + let diff = 4 + let blue' = if dir then blue+diff else blue-diff + if dir then + if blue<=maxBound-diff then writeIORef blueRef blue' else + writeIORef blueRef maxBound >> modifyIORef dirRef not + else + if blue>=minBound+diff then writeIORef blueRef blue' else + writeIORef blueRef minBound >> modifyIORef dirRef not + return True + idleAdd updateBlue priorityLow canvas `on` exposeEvent $ updateCanvas pb boxPackStartDefaults contain canvas @@ -88,7 +88,7 @@ (flip mapM_) rects $ \(Rectangle x y w h) -> do drawPixbuf win gc pb x y x y w h RgbDitherNone 0 0 return True - + -- GHC is much better at opimising loops like this: -- -- > doFromTo 0 255 $ \y -> diff --git a/demo/filechooser/FileChooserDemo.hs b/demo/filechooser/FileChooserDemo.hs --- a/demo/filechooser/FileChooserDemo.hs +++ b/demo/filechooser/FileChooserDemo.hs @@ -17,7 +17,7 @@ -- get a handle on a various objects from the glade file mainWindow <- xmlGetWidget dialogXml castToWindow "mainWindow" mainWindow `onDestroy` mainQuit - + -- and associate actions with the buttons selectFolderButton <- xmlGetWidget dialogXml castToButton "selectFolderButton" selectFolderButton `onClicked` openSelectFolderDialog mainWindow @@ -48,16 +48,16 @@ openSelectFolderDialog parentWindow = do dialog <- fileChooserDialogNew (Just $ "Demo of the standard dialog " - ++ "to select an existing folder") --dialog title + ++ "to select an existing folder") --dialog title (Just parentWindow) --the parent window - FileChooserActionSelectFolder --the kind of dialog we want - [("Yes, this new dialog looks nice" --The buttons to display - , ResponseAccept) - ,("Eugh! Take me away!" - ,ResponseCancel)] + FileChooserActionSelectFolder --the kind of dialog we want + [("Yes, this new dialog looks nice" --The buttons to display + , ResponseAccept) + ,("Eugh! Take me away!" + ,ResponseCancel)] widgetShow dialog response <- dialogRun dialog - case response of + case response of ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog putStrLn $ "you selected the folder " ++ show fileName ResponseCancel -> putStrLn "dialog canceled" @@ -68,16 +68,16 @@ openCreateFolderDialog parentWindow = do dialog <- fileChooserDialogNew (Just $ "Demo of the standard dialog to select " - ++ "a new folder (or existing) folder") --dialog title + ++ "a new folder (or existing) folder") --dialog title (Just parentWindow) --the parent window - FileChooserActionCreateFolder --the kind of dialog we want - [("I want this new folder" --The buttons to display - , ResponseAccept) - ,("Bored now." - ,ResponseCancel)] + FileChooserActionCreateFolder --the kind of dialog we want + [("I want this new folder" --The buttons to display + , ResponseAccept) + ,("Bored now." + ,ResponseCancel)] widgetShow dialog response <- dialogRun dialog - case response of + case response of ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog putStrLn $ "you selected the folder " ++ show fileName ResponseCancel -> putStrLn "Getting bored?" @@ -88,17 +88,17 @@ openOpenFileDialog parentWindow = do dialog <- fileChooserDialogNew (Just $ "Demo of the standard dialog to select " - ++ "an existing file") --dialog title + ++ "an existing file") --dialog title (Just parentWindow) --the parent window - FileChooserActionOpen --the kind of dialog we want - [("gtk-cancel" --The buttons to display - ,ResponseCancel) - ,("gtk-open" - , ResponseAccept)] + FileChooserActionOpen --the kind of dialog we want + [("gtk-cancel" --The buttons to display + ,ResponseCancel) + ,("gtk-open" + , ResponseAccept)] widgetShow dialog response <- dialogRun dialog - case response of + case response of ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog putStrLn $ "you selected the file " ++ show fileName ResponseCancel -> putStrLn "dialog canceled" @@ -109,16 +109,16 @@ openSaveFileDialog parentWindow = do dialog <- fileChooserDialogNew (Just $ "Demo of the standard dialog to select " - ++ "a new file") --dialog title + ++ "a new file") --dialog title (Just parentWindow) --the parent window - FileChooserActionSave --the kind of dialog we want - [("gtk-cancel" --The buttons to display - ,ResponseCancel) --you can use stock buttons - ,("gtk-save" - , ResponseAccept)] + FileChooserActionSave --the kind of dialog we want + [("gtk-cancel" --The buttons to display + ,ResponseCancel) --you can use stock buttons + ,("gtk-save" + , ResponseAccept)] widgetShow dialog response <- dialogRun dialog - case response of + case response of ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog putStrLn $ "you called the new file " ++ show fileName ResponseCancel -> putStrLn "dialog canceled" @@ -129,18 +129,18 @@ openFilePreviewDialog parentWindow = do dialog <- fileChooserDialogNew (Just $ "Demo of the standard dialog to select " - ++ "a new file - with a preview widget") --dialog title + ++ "a new file - with a preview widget") --dialog title (Just parentWindow) --the parent window - FileChooserActionOpen --the kind of dialog we want - [("_Yes, yes that's very clever" --The buttons to display - , ResponseAccept) - ,("_No, I'm not impressed" - ,ResponseCancel)] + FileChooserActionOpen --the kind of dialog we want + [("_Yes, yes that's very clever" --The buttons to display + , ResponseAccept) + ,("_No, I'm not impressed" + ,ResponseCancel)] --create and set an extra widget checkButton <- checkButtonNewWithLabel "frobnicate this file" dialog `fileChooserSetExtraWidget` checkButton - + --create and set a preview widget previewLabel <- labelNew $ Just "Preview appears here" previewLabel `labelSetLineWrap` True @@ -154,10 +154,10 @@ widgetShow dialog response <- dialogRun dialog - case response of + case response of ResponseAccept -> do fileName <- fileChooserGetFilename dialog putStrLn $ "you selected the new file " ++ show fileName - + --check the state of the extra widget frobnicate <- toggleButtonGetActive checkButton putStrLn $ if frobnicate @@ -166,4 +166,3 @@ ResponseCancel -> putStrLn "you were not impressed" ResponseDeleteEvent -> putStrLn "dialog closed" widgetHide dialog - diff --git a/demo/fonts/Fonts.hs b/demo/fonts/Fonts.hs --- a/demo/fonts/Fonts.hs +++ b/demo/fonts/Fonts.hs @@ -12,9 +12,8 @@ mapM_ (\fc -> do sizes <- pangoFontFaceListSizes fc let showSize Nothing = "all sizes" - showSize (Just sz) = concat (intersperse ", " (map show sz))++ - " points" + showSize (Just sz) = concat (intersperse ", " (map show sz))++ + " points" putStrLn (" "++show fc++" in "++showSize sizes) ) fcs ) ffs - diff --git a/demo/graphic/Drawing.hs b/demo/graphic/Drawing.hs --- a/demo/graphic/Drawing.hs +++ b/demo/graphic/Drawing.hs @@ -39,8 +39,7 @@ } drawArc win gc False 0 0 width height (135*64) (90*64) - drawLayoutWithColors win gc 30 (height `div` 2) text + drawLayoutWithColors win gc 30 (height `div` 2) text (Just (Color 0 0 0)) Nothing return True - diff --git a/demo/gtkbuilder/GtkBuilderTest.hs b/demo/gtkbuilder/GtkBuilderTest.hs --- a/demo/gtkbuilder/GtkBuilderTest.hs +++ b/demo/gtkbuilder/GtkBuilderTest.hs @@ -3,20 +3,20 @@ import Graphics.UI.Gtk main = do - initGUI - - -- Create the builder, and load the UI file - builder <- builderNew - builderAddFromFile builder "simple.ui" - - -- Retrieve some objects from the UI - window <- builderGetObject builder castToWindow "window1" - button <- builderGetObject builder castToButton "button1" - - -- Basic user interation - button `onClicked` putStrLn "button pressed!" - window `onDestroy` mainQuit - - -- Display the window - widgetShowAll window - mainGUI + initGUI + + -- Create the builder, and load the UI file + builder <- builderNew + builderAddFromFile builder "simple.ui" + + -- Retrieve some objects from the UI + window <- builderGetObject builder castToWindow "window1" + button <- builderGetObject builder castToButton "button1" + + -- Basic user interation + button `onClicked` putStrLn "button pressed!" + window `onDestroy` mainQuit + + -- Display the window + widgetShowAll window + mainGUI diff --git a/demo/inputmethod/Layout.hs b/demo/inputmethod/Layout.hs --- a/demo/inputmethod/Layout.hs +++ b/demo/inputmethod/Layout.hs @@ -43,7 +43,7 @@ main = do initGUI - + -- Create the main window. win <- windowNew on win objectDestroy mainQuit @@ -51,18 +51,18 @@ area <- drawingAreaNew containerAdd win area on area sizeRequest $ return (Requisition 100 100) - + -- Our widget's data buffer <- newIORef defaultBuffer preeditRef <- newIORef Nothing - + -- Create a Cairo Context that contains information about the current font, -- etc. ctxt <- cairoCreateContext Nothing lay <- layoutEmpty ctxt layoutSetWrap lay WrapWholeWords - + let relayout = do buffer@(Buffer _ cursor) <- readIORef buffer preedit <- readIORef preeditRef @@ -75,19 +75,19 @@ layoutSetAttributes lay (map (shiftAttribute (cursor + 1)) (concat attrs)) widgetQueueDraw area - + relayout - + -- Wrap the layout to a different width each time the window is resized. on area sizeAllocate $ \(Rectangle _ _ w _) -> layoutSetWidth lay (Just (fromIntegral w)) - + -- Setup the handler to draw the layout. on area exposeEvent $ updateArea area lay - + -- Set up input method im <- imMulticontextNew - + on im imContextPreeditStart $ do writeIORef preeditRef (Just ("",[],0)) relayout @@ -107,7 +107,7 @@ on im imContextDeleteSurrounding' $ \off nchars -> do putStrLn $ "delete-surrounding("++show off++","++show nchars++")" return False - + on win realize $ do imContextSetClientWindow im . Just =<< widgetGetDrawWindow win on win focusInEvent $ liftIO (imContextFocusIn im) >> return False @@ -120,7 +120,7 @@ case mod of Just f -> liftIO $ modifyIORef buffer f >> relayout >> return True Nothing -> return False - + widgetShowAll win mainGUI diff --git a/demo/menu/ComboDemo.hs b/demo/menu/ComboDemo.hs --- a/demo/menu/ComboDemo.hs +++ b/demo/menu/ComboDemo.hs @@ -11,7 +11,7 @@ initGUI win <- windowNew - onDestroy win mainQuit + onDestroy win mainQuit combo <- comboBoxEntryNewText mapM_ (comboBoxAppendText combo) @@ -19,11 +19,11 @@ -- select the first item comboBoxSetActive combo 0 - + -- Get the entry widget that the ComboBoxEntry uses. (Just w) <- binGetChild combo let entry = castToEntry w - + -- Whenever the user has completed editing the text, append the new -- text to the store unless it's already in there. onEntryActivate entry $ do @@ -38,6 +38,6 @@ return () containerAdd win combo - + widgetShowAll win - mainGUI + mainGUI diff --git a/demo/notebook/Makefile b/demo/notebook/Makefile new file mode 100644 --- /dev/null +++ b/demo/notebook/Makefile @@ -0,0 +1,15 @@ + +PROGS = notebook +SOURCES = Notebook.hs + +all : $(PROGS) + +notebook : Notebook.hs + $(HC_RULE) + +HC_RULE = $(HC) --make $< -o $@ $(HCFLAGS) + +clean: + rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS) + +HC=ghc diff --git a/demo/notebook/Notebook.hs b/demo/notebook/Notebook.hs new file mode 100644 --- /dev/null +++ b/demo/notebook/Notebook.hs @@ -0,0 +1,141 @@ +-- | Notebook demo (include Spinner animation). +-- Author : Andy Stewart +-- Copyright : (c) 2010 Andy Stewart + +module Main where + +import Control.Monad +import Control.Monad.Trans +import Data.Maybe +import Graphics.UI.Gtk + +data NotebookTab = + NotebookTab {ntBox :: HBox + ,ntSpinner :: Spinner + ,ntLabel :: Label + ,ntCloseButton :: ToolButton + ,ntSize :: Int} + +-- | Main +main :: IO () +main = do + -- Init. + initGUI + + -- Create window and notebook. + window <- windowNew + notebook <- notebookNew + + -- Set window. + windowSetDefaultSize window 800 600 + windowSetPosition window WinPosCenter + set window [windowTitle := "Press Ctrl + n to create new tab."] + + -- Handle key press action. + window `on` keyPressEvent $ tryEvent $ do + -- Create new tab when user press Ctrl+n + [Control] <- eventModifier + "n" <- eventKeyName + liftIO $ do + -- Create text view. + textView <- textViewNew + widgetShowAll textView -- must show before add notebook, + -- otherwise notebook won't display child widget + -- even have add in notebook. + + -- Create notebook tab. + tab <- notebookTabNew (Just "Cool tab") Nothing + menuLabel <- labelNew Nothing + + -- Add widgets in notebook. + notebookAppendPageMenu notebook textView (ntBox tab) menuLabel + + -- Start spinner animation when create tab. + notebookTabStart tab + + -- Stop spinner animation after finish load. + timeoutAdd (notebookTabStop tab >> return False) 5000 + + -- Close tab when click button. + ntCloseButton tab `onToolButtonClicked` do + index <- notebookPageNum notebook textView + index ?>= \i -> notebookRemovePage notebook i + + return () + + -- Show window. + window `containerAdd` notebook + widgetShowAll window + onDestroy window mainQuit + mainGUI + +-- | Create notebook tab. +notebookTabNew :: Maybe String -> Maybe Int -> IO NotebookTab +notebookTabNew name size = do + -- Init. + let iconSize = fromMaybe 12 size + box <- hBoxNew False 0 + spinner <- spinnerNew + label <- labelNew name + image <- imageNewFromIcon "gtk-close" iconSize + closeButton <- toolButtonNew (Just image) Nothing + + -- Show. + boxPackStart box label PackNatural 0 + boxPackStart box closeButton PackNatural 0 + widgetShowAll box + + return $ NotebookTab box spinner label closeButton iconSize + +-- | Set tab name. +notebookTabSetName :: NotebookTab -> String -> IO () +notebookTabSetName tab = + labelSetText (ntLabel tab) + +-- | Start spinner animation. +notebookTabStart :: NotebookTab -> IO () +notebookTabStart NotebookTab {ntBox = box + ,ntSpinner = spinner + ,ntSize = size} = do + boxTryPack box spinner PackNatural (Just 0) (size `div` 2) + spinnerStart spinner + widgetShow spinner + +-- | Stop spinner animation. +notebookTabStop :: NotebookTab -> IO () +notebookTabStop NotebookTab {ntBox = box + ,ntSpinner = spinner} = do + containerTryRemove box spinner + spinnerStop spinner + +-- | Create image widget with given icon name and size. +imageNewFromIcon :: String -> Int -> IO Image +imageNewFromIcon iconName size = do + iconTheme <- iconThemeGetDefault + pixbuf <- do + -- Function 'iconThemeLoadIcon' can scale icon with specified size. + pixbuf <- iconThemeLoadIcon iconTheme iconName size IconLookupUseBuiltin + case pixbuf of + Just p -> return p + Nothing -> error $ "imageNewFromIcon : search icon " ++ iconName ++ " failed." + imageNewFromPixbuf pixbuf + +-- | Try to packing widget in box. +-- If @child@ have exist parent, do nothing, +-- otherwise, add @child@ to @parent@. +boxTryPack :: (BoxClass parent, WidgetClass child) => parent -> child -> Packing -> Maybe Int -> Int -> IO () +boxTryPack box widget packing order space = do + parent <- widgetGetParent widget + when (isNothing parent) $ do + boxPackStart box widget packing space + order ?>= boxReorderChild box widget + +-- | Try to remove child from parent. +containerTryRemove :: (ContainerClass parent, WidgetClass child) => parent -> child -> IO () +containerTryRemove parent widget = do + hasParent <- widgetGetParent widget + unless (isNothing hasParent) $ containerRemove parent widget + +-- | Maybe. +(?>=) :: Monad m => Maybe a -> (a -> m ()) -> m () +m ?>= f = maybe (return ()) f m diff --git a/demo/statusicon/StatusIcon.hs b/demo/statusicon/StatusIcon.hs --- a/demo/statusicon/StatusIcon.hs +++ b/demo/statusicon/StatusIcon.hs @@ -9,7 +9,7 @@ statusIconSetVisible icon True statusIconSetTooltip icon "This is a test" menu <- mkmenu icon - I.onPopupMenu icon $ \b a -> do + I.onPopupMenu icon $ \b a -> do widgetShowAll menu print (b,a) menuPopup menu $ maybe Nothing (\b' -> Just (b',a)) b @@ -17,14 +17,14 @@ putStrLn "'activate' signal triggered" mainGUI -mkmenu s = do +mkmenu s = do m <- menuNew mapM_ (mkitem m) [("Let's blink!",statusIconSetBlinking s True) ,("Let's stop blink!",statusIconSetBlinking s False) - ,("Quit",mainQuit)] + ,("Quit",mainQuit)] return m where - mkitem menu (label,act) = + mkitem menu (label,act) = do i <- menuItemNewWithLabel label menuShellAppend menu i i `onActivateLeaf` act diff --git a/demo/treeList/Completion.hs b/demo/treeList/Completion.hs deleted file mode 100644 --- a/demo/treeList/Completion.hs +++ /dev/null @@ -1,82 +0,0 @@ --- Demo to show off entry completion. - -import Graphics.UI.Gtk -import Data.Char -import Data.List - -data ColorDesc = ColorDesc { - cdColor :: Color, - cdName :: String - } deriving Show - -compareCol :: ColumnId ColorDesc String -compareCol = makeColumnIdString 0 - -invertColor (Color r g b) = Color (32767+r) (32767+g) (32767+b) ---Color (65535-r) (65535-g) (65535-b) - -parseColor s = ColorDesc c (dropWhile isSpace (upperToSpace name)) - where - s1 = dropWhile isSpace s - (s2,s3) = span isDigit s1 - s4 = dropWhile isSpace s3 - (s5,s6) = span isDigit s4 - s7 = dropWhile isSpace s6 - (s8,s9) = span isDigit s7 - n1 = read ('0':s2) - n2 = read ('0':s5) - n3 = read ('0':s8) - c = Color (n1*256+n1) (n2*256+n2) (n3*256+n3) - name = dropWhile isSpace s9 - upperToSpace [] = [] - upperToSpace (x:xs) | isUpper x = ' ':toLower x:upperToSpace xs - | otherwise = x:upperToSpace xs - -main = - do - initGUI - window <- windowNew - - contents <- readFile "rgb.txt" - let killDups [] = [] - killDups [x] = [x] - killDups (x:y:xs) | cdName x==cdName y = killDups (y:xs) - | otherwise = x:killDups (y:xs) - cols = killDups $ map parseColor (drop 1 (lines contents)) - store <- listStoreNew cols - customStoreSetColumn store compareCol cdName - - entry <- entryNew - completion <- entryCompletionNew - entrySetCompletion entry completion - - set completion [entryCompletionModel := Just store] - cell <- cellRendererTextNew - set cell [cellTextBackgroundSet := True, - cellTextForegroundSet := True] - cellLayoutPackStart completion cell True - cellLayoutSetAttributes completion cell store - (\cd -> [cellText := cdName cd, - cellTextBackgroundColor := cdColor cd, - cellTextForegroundColor := invertColor (cdColor cd)]) - entryCompletionSetMatchFunc completion (matchFunc store) - on completion matchSelected $ \model iter -> do - color <- treeModelGetValue model iter compareCol - entrySetText entry color - return True - set window [containerChild := entry] - widgetShowAll window - onDestroy window mainQuit - mainGUI - -matchFunc :: ListStore ColorDesc -> String -> TreeIter -> IO Bool -matchFunc model str iter = do - --putStrLn ("iter is "++show iter) - tp <- treeModelGetPath model iter - r <- case tp of - (i:_) -> do row <- listStoreGetValue model i - return $ any (isPrefixOf (map toLower str)) - (words (map toLower (cdName row))) - otherwise -> return False - return r - diff --git a/demo/treeList/DirList.hs b/demo/treeList/DirList.hs deleted file mode 100644 --- a/demo/treeList/DirList.hs +++ /dev/null @@ -1,82 +0,0 @@ -{-# OPTIONS -cpp #-} --- Test file for the ListView widget. -module Main(main) where - -import Graphics.UI.Gtk -import Graphics.UI.Gtk.ModelView as New - -import Control.Exception -import System.Directory -import System.IO -import System.Locale -import System.Time - -data FileInfo = FileInfo { - fName :: String, - fSize :: Integer, - fTime :: ClockTime -} - -main = do - initGUI - win <- windowNew - win `onDestroy` mainQuit - - curDir <- getCurrentDirectory - files <- getDirectoryContents curDir - fInfos <- (flip mapM) files $ \f -> do - s <- handle (\e -> -#if __GLASGOW_HASKELL__>=610 - case e :: SomeException of - e -> -#endif - return 0) $ do - h <- openFile f ReadMode - s <- hFileSize h - hClose h - return s - t <- getModificationTime f - return FileInfo { fName = f - , fSize = s - , fTime = t } - - store <- New.listStoreNew fInfos - - tv <- New.treeViewNewWithModel store - containerAdd win tv - - tvc <- New.treeViewColumnNew - set tvc [ New.treeViewColumnTitle := "File name" - , New.treeViewColumnResizable := True ] - New.treeViewAppendColumn tv tvc - - name <- New.cellRendererTextNew - New.treeViewColumnPackStart tvc name True - New.cellLayoutSetAttributes tvc name store $ \FileInfo { fName = name } -> - [ New.cellText := name ] - - tvc <- New.treeViewColumnNew - set tvc [ New.treeViewColumnTitle := "Size" - , New.treeViewColumnResizable := True ] - New.treeViewAppendColumn tv tvc - - size <- New.cellRendererTextNew - New.treeViewColumnPackStart tvc size True - New.cellLayoutSetAttributes tvc size store $ \FileInfo { fSize = size } -> - [ New.cellText := show size ] - - tvc <- New.treeViewColumnNew - set tvc [ New.treeViewColumnTitle := "Modification time" - , New.treeViewColumnResizable := True ] - New.treeViewAppendColumn tv tvc - - time <- New.cellRendererTextNew - New.treeViewColumnPackStart tvc time True - New.cellLayoutSetAttributes tvc time store $ \FileInfo { fTime = time } -> - [ New.cellText :=> do - calTime <- toCalendarTime time - return (formatCalendarTime defaultTimeLocale "%D %T" calTime) - ] - - widgetShowAll win - mainGUI diff --git a/demo/treeList/FilterDemo.hs b/demo/treeList/FilterDemo.hs deleted file mode 100644 --- a/demo/treeList/FilterDemo.hs +++ /dev/null @@ -1,71 +0,0 @@ --- a demo that shows how to create a normal tree view and a tree view in --- which only a chosen subset of rows are shown (namely those with upper case letters) -module Main ( main ) where - -import Graphics.UI.Gtk -import Data.List -import Data.Char -import Debug.Trace - --- | Define a virtual column of the model that determines the visibility of a row in --- the model. -visCol :: ColumnId String Bool -visCol = makeColumnIdBool 0 - -main = do - initGUI - - win <- windowNew - onDestroy win mainQuit - - content <- readFile "FilterDemo.hs" - - -- create a view that shows all lines - model <- listStoreNew (lines content) - viewAll <- treeViewNewWithModel model - col <- treeViewColumnNew - ren <- cellRendererTextNew - cellLayoutPackStart col ren True - cellLayoutSetAttributes col ren model $ \row -> [ cellText := row ] - treeViewAppendColumn viewAll col - - -- create a view that only shows lines with upper case characters - fModel <- treeModelFilterNew model [] - - -- create a virtual column 'visCol' that contains @True@ if a certain row has - -- upper case letters. Then set this column to determine the visibility of a row. - customStoreSetColumn model visCol (any isUpper) - treeModelFilterSetVisibleColumn fModel visCol - -{- - -- this is an alternative way to determine the visibility of a row. In this case, - -- it is not necessary to create the column 'visCol'. - treeModelFilterSetVisibleFunc fModel $ Just $ \iter -> do - row <- treeModelGetRow model iter - return (any isUpper row) --} - -- note: it is important to insert the model into the view after the visibility - -- row or the visibility function have been set. Otherwise, the view is filled - -- first and setting a new visibility column/function will not update the view. - viewFew <- treeViewNewWithModel fModel - col <- treeViewColumnNew - ren <- cellRendererTextNew - cellLayoutPackStart col ren True - cellLayoutSetAttributes col ren model $ \row -> [ cellText := row ] - - treeViewAppendColumn viewFew col - - - - box <- vBoxNew False 0 - swAll <- scrolledWindowNew Nothing Nothing - containerAdd swAll viewAll - boxPackStart box swAll PackGrow 4 - - swFew <- scrolledWindowNew Nothing Nothing - containerAdd swFew viewFew - boxPackEnd box swFew PackGrow 4 - - containerAdd win box - widgetShowAll win - mainGUI diff --git a/demo/treeList/ListDND.hs b/demo/treeList/ListDND.hs deleted file mode 100644 --- a/demo/treeList/ListDND.hs +++ /dev/null @@ -1,248 +0,0 @@ -module Main where - -import Graphics.UI.Gtk -import Graphics.UI.Gtk.Gdk.EventM - -import System.Glib.GObject ( toGObject ) -import System.FilePath -import Control.Concurrent.MVar -import Control.Monad ( liftM ) -import Control.Monad.Trans ( liftIO ) -import Data.Maybe ( fromMaybe ) -import Data.List ( findIndex ) - -roomStrCol :: ColumnId String String -roomStrCol = makeColumnIdString 1 - --- Define a string column and an image column on the store holding the --- computer types. -compPicCol :: ColumnId CompType Pixbuf -compPicCol = makeColumnIdPixbuf 1 - -compStrCol :: ColumnId CompType String -compStrCol = makeColumnIdString 2 - -data Computer = Computer { - name :: String, - addr :: (Int, Int, Int, Int), - roomStore :: ListStore String, - roomSel :: Int, - cType :: CompType } - -data CompType - = MacBookPro - | MacBook - | Printer - | MacPro - | Xserve - | IMac - deriving (Enum, Bounded, Show) - -showCT :: CompType -> String -showCT ct = case show ct of - 'I':xs -> 'i':xs - xs -> xs - -main = do - initGUI - - win <- windowNew - onDestroy win mainQuit - - -- create a tag that we use as selection, target and selection type - compTypeTag <- atomNew "_CompType" - - let pNames = map ("resListDND" ) - ["laptop.png","laptopSmall.png","printer.png", - "tower.png","server.png","desktop.png"] - pics <- mapM pixbufNewFromFile pNames - - smallPics <- mapM (\n -> pixbufNewFromFileAtScale n 48 48 True) pNames - - [noRoom, publicRoom, restrictedRoom] <- mapM listStoreNew - [["Paul (Home)","John (Home)","Fred (Home)"], - ["N12","S112", "S113", "S114"], - ["Server Room Upstairs", "Server Room Downstairs"]] - - -- define extractor function for the string column - treeModelSetColumn noRoom roomStrCol id - treeModelSetColumn publicRoom roomStrCol id - treeModelSetColumn restrictedRoom roomStrCol id - - let genRoomStore MacBookPro = noRoom - genRoomStore MacBook = noRoom - genRoomStore Printer = publicRoom - genRoomStore MacPro = publicRoom - genRoomStore Xserve = restrictedRoom - genRoomStore IMac = publicRoom - - -- the initial computer list - it's a coincidence that there's - -- one computer of each type - content <- listStoreNewDND - (map (\t -> Computer { name = showCT t, addr = (192,168,0,fromEnum t+1), - roomStore = genRoomStore t, roomSel = 0, cType = t}) - [minBound :: CompType .. maxBound]) - (Just listStoreDefaultDragSourceIface) - (Just DragDestIface { - treeDragDestRowDropPossible = \store path@(i:_) -> do - mCT <- selectionDataGet compTypeTag - case mCT :: Maybe [Int] of - Just [ct] -> return True - Nothing -> - (treeDragDestRowDropPossible listStoreDefaultDragDestIface) - store path - _ -> return False, - treeDragDestDragDataReceived = \store path@(i:_) -> do - mCT <- selectionDataGet compTypeTag - case mCT of - Just [ct] -> do - let t = toEnum ct - liftIO $ listStoreInsert store i - Computer { name = showCT t, addr = (192,168,0,254), - roomStore = genRoomStore t, roomSel = 0, - cType = t } - return True - Nothing -> - (treeDragDestDragDataReceived listStoreDefaultDragDestIface) - store path - }) - -- the area with the possible computer types - compTypes <- listStoreNewDND [minBound :: CompType .. maxBound] - (Just DragSourceIface { - treeDragSourceRowDraggable = \store (i:_) -> return True, - treeDragSourceDragDataGet = \store (i:_) -> do - ty <- selectionDataGetTarget - ct <- liftIO $ listStoreGetValue store i - selectionDataSet compTypeTag [fromEnum ct] - return True, - treeDragSourceDragDataDelete = \store path -> return True - }) - Nothing - - -- define extractor functions for the two column - treeModelSetColumn compTypes compPicCol $ - \t -> pics !! fromEnum t - treeModelSetColumn compTypes compStrCol showCT - - -- create an icon view of all the computer types - typesView <- iconViewNew - set typesView [iconViewModel := Just compTypes, - iconViewPixbufColumn := compPicCol, - iconViewTextColumn := compStrCol, - iconViewColumns := 6] - - -- create an editable list of computers - inventory <- treeViewNewWithModel content - - tyCol <- treeViewColumnNew - treeViewColumnSetTitle tyCol "Type" - picRen <- cellRendererPixbufNew - treeViewColumnPackStart tyCol picRen False - cellLayoutSetAttributes tyCol picRen content - (\Computer { cType = t} -> [cellPixbuf := smallPics !! fromEnum t]) - tyRen <- cellRendererTextNew - treeViewColumnPackStart tyCol tyRen False - cellLayoutSetAttributes tyCol tyRen content - (\Computer { cType = t} -> [cellText := showCT t]) - treeViewAppendColumn inventory tyCol - - nameCol <- treeViewColumnNew - treeViewColumnSetTitle nameCol "Name" - treeViewColumnSetResizable nameCol True - treeViewColumnSetMinWidth nameCol 100 - nameRen <- cellRendererTextNew - set nameRen [ cellTextEditable := True, - cellTextEditableSet := True, - cellTextEllipsize := EllipsizeEnd, - cellTextEllipsizeSet := True] - treeViewColumnPackStart nameCol nameRen True - cellLayoutSetAttributes nameCol nameRen content - (\Computer { name = n } -> [cellText := n]) - treeViewAppendColumn inventory nameCol - on nameRen edited $ \[i] str -> do - val <- listStoreGetValue content i - listStoreSetValue content i val { name = str } - - addrCol <- treeViewColumnNew - treeViewColumnSetTitle addrCol "Address" - oct1 <- cellRendererTextNew - dot1 <- cellRendererTextNew - oct2 <- cellRendererTextNew - dot2 <- cellRendererTextNew - oct3 <- cellRendererTextNew - dot3 <- cellRendererTextNew - oct4 <- cellRendererTextNew - mapM_ (uncurry (cellLayoutPackStart addrCol)) - [(oct1, True), (dot1, False), (oct2, True), - (dot2, False), (oct3, True), (dot3, False), (oct4, True)] - mapM_ (\d -> set d [cellText := ".", - cellTextWidthChars := 0]) [dot1, dot2, dot3] - mapM_ (\o -> set o [cellXAlign := 1.0, - cellTextWidthChars := 3]) [oct1, oct2, oct3, oct4] - cellLayoutSetAttributes addrCol oct1 content - (\Computer { addr = (o1,_,_,_)} -> [cellText := show o1]) - cellLayoutSetAttributes addrCol oct2 content - (\Computer { addr = (_,o2,_,_)} -> [cellText := show o2]) - cellLayoutSetAttributes addrCol oct3 content - (\Computer { addr = (_,_,o3,_)} -> [cellText := show o3]) - cellLayoutSetAttributes addrCol oct4 content - (\Computer { addr = (_,_,_,o4)} -> [cellText := show o4]) - treeViewAppendColumn inventory addrCol - - roomCol <- treeViewColumnNew - treeViewColumnSetTitle roomCol "Room" - treeViewColumnSetResizable roomCol True - treeViewColumnSetSizing roomCol TreeViewColumnAutosize - roomRen <- cellRendererComboNew - set roomRen [ cellTextEditable := True, - cellTextEditableSet := True, - cellComboHasEntry := True ] - treeViewColumnPackStart roomCol roomRen True - cellLayoutSetAttributes roomCol roomRen content - (\Computer { roomStore = t, roomSel = idx } -> - [cellText :=> listStoreGetValue t idx, - cellComboTextModel := (t, roomStrCol)]) - on roomRen edited $ \[i] str -> do - row@Computer { roomStore = t } <- listStoreGetValue content i - elems <- listStoreToList t - idx <- case (findIndex ((==) str) elems) of - Just idx -> return idx - Nothing -> listStoreAppend t str - listStoreSetValue content i row { roomSel = idx } - treeViewAppendColumn inventory roomCol - - -- make typesView a drag source for compTypeTag values - tl <- targetListNew - targetListAdd tl compTypeTag [TargetSameApp] 0 - iconViewEnableModelDragSource typesView [Button1] tl [ActionCopy] - - -- Due to a bug in Gtk+, the treeDragSourceDragDataGet handler in - -- the DND source handler is not called unless the IconView is also - -- set to be a DND destination. Bugzilla 550528 - tl <- targetListNew - iconViewEnableModelDragDest typesView tl [] - - -- make the inventory widget a drag destination for compTypeTag values - tl <- targetListNew - targetListAdd tl compTypeTag [TargetSameApp] 0 - targetListAdd tl targetTreeModelRow [TargetSameWidget] 0 - treeViewEnableModelDragDest inventory tl [ActionMove] - tl <- targetListNew - targetListAdd tl targetTreeModelRow [TargetSameWidget] 0 - treeViewEnableModelDragSource inventory [Button1] tl [ActionMove] - - -- Install drag and drop for permuting rows. This is now done above using - -- the explicit target 'targetTreeModelRow'. Calling the function below - -- will set a completely new 'TargetList' thereby removing our own - -- 'compTypeTag' from the inventory widget's target list. - - --treeViewSetReorderable inventory True - - -- arrange the widgets - v <- vPanedNew - panedAdd1 v typesView - panedAdd2 v inventory - containerAdd win v - - widgetShowAll win - mainGUI diff --git a/demo/treeList/ListDemo.hs b/demo/treeList/ListDemo.hs deleted file mode 100644 --- a/demo/treeList/ListDemo.hs +++ /dev/null @@ -1,66 +0,0 @@ -module Main where - -import Graphics.UI.Gtk -import System.Glib.Signals (on) -import Data.List ( isPrefixOf ) -import Data.Char ( toLower ) - -data Phone = Phone { name :: String, number :: Int, marked :: Bool } - -main = do - initGUI - - win <- windowNew - onDestroy win mainQuit - - -- create a new list model - model <- listStoreNew - [Phone { name = "Foo", number = 12345, marked = False } - ,Phone { name = "Bar", number = 67890, marked = True } - ,Phone { name = "Baz", number = 39496, marked = False }] - view <- treeViewNewWithModel model - - treeViewSetHeadersVisible view True - - -- add a couple columns - col1 <- treeViewColumnNew - col2 <- treeViewColumnNew - col3 <- treeViewColumnNew - - treeViewColumnSetTitle col1 "String column" - treeViewColumnSetTitle col2 "Int column" - treeViewColumnSetTitle col3 "Bool column" - - renderer1 <- cellRendererTextNew - renderer2 <- cellRendererTextNew - renderer3 <- cellRendererToggleNew - - cellLayoutPackStart col1 renderer1 True - cellLayoutPackStart col2 renderer2 True - cellLayoutPackStart col3 renderer3 True - - cellLayoutSetAttributes col1 renderer1 model $ \row -> [ cellText := name row ] - cellLayoutSetAttributes col2 renderer2 model $ \row -> [ cellText := show (number row) ] - cellLayoutSetAttributes col3 renderer3 model $ \row -> [ cellToggleActive := marked row ] - - treeViewAppendColumn view col1 - treeViewAppendColumn view col2 - treeViewAppendColumn view col3 - - -- update the model when the toggle buttons are activated - on renderer3 cellToggled $ \pathStr -> do - let (i:_) = stringToTreePath pathStr - val <- listStoreGetValue model i - listStoreSetValue model i val { marked = not (marked val) } - - - -- enable interactive search - treeViewSetEnableSearch view True - treeViewSetSearchEqualFunc view $ Just $ \str iter -> do - (i:_) <- treeModelGetPath model iter - row <- listStoreGetValue model i - return (map toLower str `isPrefixOf` map toLower (name row)) - - containerAdd win view - widgetShowAll win - mainGUI diff --git a/demo/treeList/ListTest.glade b/demo/treeList/ListTest.glade deleted file mode 100644 --- a/demo/treeList/ListTest.glade +++ /dev/null @@ -1,1404 +0,0 @@ - - - - - - - True - List Test - GTK_WINDOW_TOPLEVEL - GTK_WIN_POS_NONE - False - True - False - True - False - False - GDK_WINDOW_TYPE_HINT_NORMAL - GDK_GRAVITY_NORTH_WEST - True - - - - True - False - 0 - - - - True - True - GTK_POLICY_ALWAYS - GTK_POLICY_ALWAYS - GTK_SHADOW_IN - GTK_CORNER_TOP_LEFT - - - - True - True - True - False - False - True - False - False - False - - - - - 0 - True - True - - - - - - True - False - 0 - - - - 8 - True - False - 12 - - - - True - True - True - 0 - - - - 2 - True - 3 - 2 - False - 2 - 18 - - - - True - True - 1 - 0 - True - GTK_UPDATE_ALWAYS - True - False - 1 0 100 1 10 10 - - - 1 - 2 - 1 - 2 - - - - - - - True - True - GTK_RELIEF_NORMAL - True - False - False - True - - - 1 - 2 - 2 - 3 - fill - - - - - - - True - String value: - False - False - GTK_JUSTIFY_LEFT - False - False - 1 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - 1 - 0 - 1 - - - - - - - True - Number value: - False - False - GTK_JUSTIFY_LEFT - False - False - 1 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - 1 - 1 - 2 - - - - - - - True - Boolean value: - False - False - GTK_JUSTIFY_LEFT - False - False - 1 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - 1 - 2 - 3 - - - - - - - True - True - True - True - 0 - - True - * - False - - - 1 - 2 - 0 - 1 - expand|shrink|fill - - - - - - - - - True - <b>Value</b> - False - True - GTK_JUSTIFY_LEFT - False - False - 0.5 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - label_item - - - - - 0 - False - False - - - - - - True - True - True - 0 - - - - 4 - True - False - 2 - - - - True - True - 0 - - - - True - True - insert - True - GTK_RELIEF_NORMAL - True - - - 0 - True - True - - - - - - True - new entry at - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - True - - - - - - True - True - 1 - 0 - False - GTK_UPDATE_ALWAYS - False - False - 1 0 100 1 10 10 - - - 4 - False - False - - - - - 0 - True - True - - - - - - True - True - 0 - - - - True - True - prepend - True - GTK_RELIEF_NORMAL - True - - - 0 - True - True - - - - - - True - new entry - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - True - - - - - - True - - False - False - GTK_JUSTIFY_LEFT - False - False - 0.5 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - False - - - - - 0 - True - True - - - - - - True - True - 0 - - - - True - True - append - True - GTK_RELIEF_NORMAL - True - - - 0 - True - True - - - - - - True - new entry - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - True - - - - - - True - - False - False - GTK_JUSTIFY_LEFT - False - False - 0.5 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - False - - - - - 0 - True - True - - - - - - True - True - 0 - - - - True - True - update - True - GTK_RELIEF_NORMAL - True - - - 0 - True - True - - - - - - True - entry - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - True - - - - - - True - True - 1 - 0 - False - GTK_UPDATE_ALWAYS - False - False - 1 0 100 1 10 10 - - - 0 - False - False - - - - - 0 - True - True - - - - - - - - True - <b>Insert and Update</b> - False - True - GTK_JUSTIFY_LEFT - False - False - 0.5 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - label_item - - - - - 0 - False - False - - - - - - True - True - True - 0 - - - - True - False - 2 - - - - 4 - True - True - 0 - - - - 54 - True - True - delete - True - GTK_RELIEF_NORMAL - True - - - 0 - False - False - - - - - - True - entry - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - True - - - - - - True - True - 1 - 0 - False - GTK_UPDATE_ALWAYS - False - False - 1 0 100 1 10 10 - - - 0 - False - False - - - - - - True - - False - False - GTK_JUSTIFY_LEFT - False - False - 0.5 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - False - - - - - - True - - False - False - GTK_JUSTIFY_LEFT - False - False - 0.5 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - False - - - - - 0 - True - True - - - - - - 4 - True - True - 0 - - - - True - True - clear - True - GTK_RELIEF_NORMAL - True - - - 0 - False - True - - - - - - True - all - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - True - - - - - - True - - False - False - GTK_JUSTIFY_LEFT - False - False - 0.5 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - False - - - - - - True - - False - False - GTK_JUSTIFY_LEFT - False - False - 0.5 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - False - - - - - - True - - False - False - GTK_JUSTIFY_LEFT - False - False - 0.5 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - False - - - - - 0 - True - True - - - - - - - - True - <b>Delete</b> - False - True - GTK_JUSTIFY_LEFT - False - False - 0.5 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - label_item - - - - - 0 - False - False - - - - - - True - True - False - 0 - - - - 4 - True - False - 2 - - - - True - True - 0 - - - - 54 - True - True - move - True - GTK_RELIEF_NORMAL - True - - - 0 - False - False - - - - - - True - entry - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - True - - - - - - True - True - 1 - 0 - False - GTK_UPDATE_ALWAYS - False - False - 1 0 100 1 10 10 - - - 0 - True - False - - - - - - True - before - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - True - - - - - - True - True - 1 - 0 - False - GTK_UPDATE_ALWAYS - False - False - 1 0 100 1 10 10 - - - 0 - True - False - - - - - 0 - False - False - - - - - - True - True - 0 - - - - 54 - True - True - move - True - GTK_RELIEF_NORMAL - True - - - 0 - False - False - - - - - - True - entry - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - True - - - - - - True - True - 1 - 0 - False - GTK_UPDATE_ALWAYS - False - False - 1 0 100 1 10 10 - - - 0 - True - False - - - - - - True - after - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - True - - - - - - True - True - 1 - 0 - False - GTK_UPDATE_ALWAYS - False - False - 1 0 100 1 10 10 - - - 0 - True - False - - - - - 0 - False - False - - - - - - - - True - <b>Move</b> - False - True - GTK_JUSTIFY_LEFT - False - False - 0.5 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - label_item - - - - - 0 - False - False - - - - - - True - True - False - 0 - - - - 4 - True - True - 0 - - - - 54 - True - True - swap - True - GTK_RELIEF_NORMAL - True - - - 0 - False - False - - - - - - True - entry - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - True - - - - - - True - True - 1 - 0 - False - GTK_UPDATE_ALWAYS - False - False - 1 0 100 1 10 10 - - - 0 - False - False - - - - - - True - with - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - True - - - - - - True - True - 1 - 0 - False - GTK_UPDATE_ALWAYS - False - False - 1 0 100 1 10 10 - - - 0 - False - False - - - - - - - - True - <b>Swap</b> - False - True - GTK_JUSTIFY_LEFT - False - False - 0.5 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - label_item - - - - - 0 - False - False - - - - - - True - True - False - 0 - - - - - - - - True - <b>Reorder</b> - False - True - GTK_JUSTIFY_LEFT - False - False - 0.5 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - label_item - - - - - 0 - False - False - - - - - 0 - False - False - - - - - 0 - False - True - - - - - - - diff --git a/demo/treeList/ListTest.hs b/demo/treeList/ListTest.hs deleted file mode 100644 --- a/demo/treeList/ListTest.hs +++ /dev/null @@ -1,102 +0,0 @@ -module Main where - -import Graphics.UI.Gtk -import Graphics.UI.Gtk.Glade -import Graphics.UI.Gtk.ModelView as New - -data Phone = Phone { name :: String, number :: Int, marked :: Bool } - -main = do - initGUI - Just xml <- xmlNew "ListTest.glade" - - win <- xmlGetWidget xml castToWindow "window" - onDestroy win mainQuit - - view <- xmlGetWidget xml castToTreeView "view" - - stringValue <- xmlGetWidget xml castToEntry "stringValue" - intValue <- xmlGetWidget xml castToSpinButton "intValue" - boolValue <- xmlGetWidget xml castToCheckButton "boolValue" - - insertButton <- xmlGetWidget xml castToButton "insert" - prependButton <- xmlGetWidget xml castToButton "prepend" - appendButton <- xmlGetWidget xml castToButton "append" - updateButton <- xmlGetWidget xml castToButton "update" - newIndex <- xmlGetWidget xml castToSpinButton "newIndex" - updateIndex <- xmlGetWidget xml castToSpinButton "updateIndex" - - removeButton <- xmlGetWidget xml castToButton "remove" - clearButton <- xmlGetWidget xml castToButton "clear" - removeIndex <- xmlGetWidget xml castToSpinButton "removeIndex" - - -- create a new list store - store <- storeImpl - New.treeViewSetModel view store - setupView view store - - let getValues = do - name <- entryGetText stringValue - number <- spinButtonGetValue intValue - marked <- toggleButtonGetActive boolValue - return Phone { - name = name, - number = floor number, - marked = marked - } - - onClicked prependButton $ getValues >>= New.listStorePrepend store - onClicked appendButton $ getValues >>= New.listStoreAppend store >> return () - - onClicked insertButton $ do - value <- getValues - index <- fmap floor $ spinButtonGetValue newIndex - New.listStoreInsert store index value - - onClicked updateButton $ do - value <- getValues - index <- fmap floor $ spinButtonGetValue updateIndex - New.listStoreSetValue store index value - - onClicked removeButton $ do - index <- fmap floor $ spinButtonGetValue removeIndex - New.listStoreRemove store index - - onClicked clearButton $ New.listStoreClear store - - New.treeViewSetReorderable view True - --- containerAdd win view - widgetShowAll win - mainGUI - -setupView view model = do - New.treeViewSetHeadersVisible view True - - -- add a couple columns - renderer1 <- New.cellRendererTextNew - col1 <- New.treeViewColumnNew - New.treeViewColumnPackStart col1 renderer1 True - New.cellLayoutSetAttributes col1 renderer1 model $ \row -> [ New.cellText := name row ] - New.treeViewColumnSetTitle col1 "String column" - New.treeViewAppendColumn view col1 - - renderer2 <- New.cellRendererTextNew - col2 <- New.treeViewColumnNew - New.treeViewColumnPackStart col2 renderer2 True - New.cellLayoutSetAttributes col2 renderer2 model $ \row -> [ New.cellText := show (number row) ] - New.treeViewColumnSetTitle col2 "Int column" - New.treeViewAppendColumn view col2 - - renderer3 <- New.cellRendererToggleNew - col3 <- New.treeViewColumnNew - New.treeViewColumnPackStart col3 renderer3 True - New.cellLayoutSetAttributes col3 renderer3 model $ \row -> [ New.cellToggleActive := marked row ] - New.treeViewColumnSetTitle col3 "Check box column" - New.treeViewAppendColumn view col3 - -storeImpl = - New.listStoreNew - [Phone { name = "Foo", number = 12345, marked = False } - ,Phone { name = "Bar", number = 67890, marked = True } - ,Phone { name = "Baz", number = 39496, marked = False }] diff --git a/demo/treeList/ListText.hs b/demo/treeList/ListText.hs deleted file mode 100644 --- a/demo/treeList/ListText.hs +++ /dev/null @@ -1,78 +0,0 @@ -import Graphics.UI.Gtk -import Data.Char -import Data.List -import Data.Maybe - -data RowInfo = RowInfo { rowString :: String, rowCase :: Maybe Bool } - -mkCase Nothing str = str -mkCase (Just False) str = map toLower str -mkCase (Just True) str = map toUpper str - -advCase Nothing = Just False -advCase (Just False) = Just True -advCase (Just True) = Nothing - -main :: IO () -main = do - unsafeInitGUIForThreadedRTS - win <- windowNew - win `on` objectDestroy $ mainQuit - - content <- readFile "ListText.hs" - - model <- listStoreNew (map (\r -> RowInfo r Nothing) (lines content)) - view <- treeViewNewWithModel model - - -- add a column showing the index - col <- treeViewColumnNew - treeViewAppendColumn view col - - cell <- cellRendererTextNew - cellLayoutPackStart col cell True - cellLayoutSetAttributeFunc col cell model $ \(TreeIter _ n _ _) -> - set cell [cellText := show n] - set col [treeViewColumnTitle := "line", - treeViewColumnReorderable := True ] - - -- add a column showing the line in the file - col <- treeViewColumnNew - treeViewAppendColumn view col - set col [treeViewColumnTitle := "line in file", - treeViewColumnReorderable := True ] - - cell <- cellRendererTextNew - cellLayoutPackStart col cell True - cellLayoutSetAttributes col cell model $ - \row -> [cellText := mkCase (rowCase row) (rowString row)] - - -- add a column showing if it is forced to a specific case - col <- treeViewColumnNew - treeViewAppendColumn view col - set col [treeViewColumnTitle := "case", - treeViewColumnReorderable := True ] - - cell <- cellRendererToggleNew - cellLayoutPackStart col cell True - cellLayoutSetAttributes col cell model $ - \row -> [cellToggleActive := fromMaybe False (rowCase row), - cellToggleInconsistent := rowCase row==Nothing] - cell `on` cellToggled $ \tpStr -> do - let [i] = stringToTreePath tpStr - row@RowInfo { rowCase = c } <- listStoreGetValue model i - listStoreSetValue model i row { rowCase = advCase c } - - -- to annoy the user: don't allow any columns to be dropped at the far right - treeViewSetColumnDragFunction view $ Just $ \_ rCol _ -> do - return (rCol /= Nothing) - - treeViewSetSearchEqualFunc view $ Just $ \str (TreeIter _ n _ _) -> do - row <- listStoreGetValue model (fromIntegral n) - return (map toLower str `isPrefixOf` map toLower (filter isAlphaNum (rowString row))) - - swin <- scrolledWindowNew Nothing Nothing - set swin [ containerChild := view ] - set win [ containerChild := swin ] - widgetShowAll win - mainGUI - diff --git a/demo/treeList/Makefile b/demo/treeList/Makefile deleted file mode 100644 --- a/demo/treeList/Makefile +++ /dev/null @@ -1,45 +0,0 @@ - -PROGS = listdemo treedemo listtest treetest dirlist treesort completion \ - listdnd filterdemo listtext - -SOURCES = ListDemo.hs TreeDemo.hs ListTest.hs TreeTest.hs DirList.hs \ - TreeSort.hs Completion.hs ListDND.hs FilterDemo.hs ListText.hs - -all : $(PROGS) - -listdemo : ListDemo.hs - $(HC_RULE) - -treedemo : TreeDemo.hs - $(HC_RULE) - -listtest : ListTest.hs - $(HC_RULE) - -treetest : TreeTest.hs - $(HC_RULE) - -dirlist : DirList.hs - $(HC_RULE) - -treesort : TreeSort.hs - $(HC_RULE) - -completion : Completion.hs - $(HC_RULE) - -listdnd : ListDND.hs - $(HC_RULE) - -filterdemo : FilterDemo.hs - $(HC_RULE) - -listtext : ListText.hs - $(HC_RULE) - -HC_RULE = $(HC) --make $< -o $@ $(HCFLAGS) - -clean: - rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS) - -HC=ghc diff --git a/demo/treeList/TreeDemo.hs b/demo/treeList/TreeDemo.hs deleted file mode 100644 --- a/demo/treeList/TreeDemo.hs +++ /dev/null @@ -1,68 +0,0 @@ -module Main where - -import Graphics.UI.Gtk -import Graphics.UI.Gtk.ModelView as New - -import qualified Data.Tree as Tree - -data Phone = Phone { name :: String, number :: Int, marked :: Bool } - -main = do - initGUI - - win <- windowNew - onDestroy win mainQuit - - -- create a new tree model - model <- storeImpl - view <- New.treeViewNewWithModel model - - New.treeViewSetHeadersVisible view True - - -- add three columns - col1 <- New.treeViewColumnNew - col2 <- New.treeViewColumnNew - col3 <- New.treeViewColumnNew - - New.treeViewColumnSetTitle col1 "String column" - New.treeViewColumnSetTitle col2 "Int column" - New.treeViewColumnSetTitle col3 "Bool column" - - renderer1 <- New.cellRendererTextNew - renderer2 <- New.cellRendererTextNew - renderer3 <- New.cellRendererToggleNew - - New.cellLayoutPackStart col1 renderer1 True - New.cellLayoutPackStart col2 renderer2 True - New.cellLayoutPackStart col3 renderer3 True - - New.cellLayoutSetAttributes col1 renderer1 model $ \row -> [ New.cellText := name row ] - New.cellLayoutSetAttributes col2 renderer2 model $ \row -> [ New.cellText := show (number row) ] - New.cellLayoutSetAttributes col3 renderer3 model $ \row -> [ New.cellToggleActive := marked row ] - - New.treeViewAppendColumn view col1 - New.treeViewAppendColumn view col2 - New.treeViewAppendColumn view col3 - - containerAdd win view - widgetShowAll win - mainGUI - -storeImpl = - New.treeStoreNew - [Tree.Node { - Tree.rootLabel = Phone { name = "Foo", number = 1, marked = False }, - Tree.subForest = [leafNode Phone { name = "Bar", number = 11, marked = True } - ,leafNode Phone { name = "Baz", number = 12, marked = False }] - }, - Tree.Node { - Tree.rootLabel = Phone { name = "Foo", number = 2, marked = False }, - Tree.subForest = [leafNode Phone { name = "Bar", number = 21, marked = True } - ,leafNode Phone { name = "Baz", number = 22, marked = False }] - }, - Tree.Node { - Tree.rootLabel = Phone { name = "Foo", number = 3, marked = False }, - Tree.subForest = [leafNode Phone { name = "Bar", number = 31, marked = True } - ,leafNode Phone { name = "Baz", number = 32, marked = False }] - }] - where leafNode a = Tree.Node { Tree.rootLabel = a, Tree.subForest = [] } diff --git a/demo/treeList/TreeSort.hs b/demo/treeList/TreeSort.hs deleted file mode 100644 --- a/demo/treeList/TreeSort.hs +++ /dev/null @@ -1,85 +0,0 @@ -import Graphics.UI.Gtk -import Graphics.UI.Gtk.ModelView as New -import Data.Tree - -main = do - initGUI - win <- windowNew - -- Create a tree model with some unsorted data. - rawmodel <- New.treeStoreNew - [Node ("zoo",8) [], Node ("foo",5) [], - Node ("bar",20) [], Node ("baz",2) []] - - -- Create a sorting proxy model, that is, a model that permutates the - -- rows of a different model such that they appear to be sorted. - model <- New.treeModelSortNewWithModel rawmodel - - -- Define two sorting functions, one being the default sorting function and - -- the other one being the sorting function for the 'SortColumnId' 2. - -- 'SortColumnId's are arbitrary positive numbers, i.e., we could have chosen - -- any other unique number. - New.treeSortableSetDefaultSortFunc model $ \iter1 iter2 -> do - (t1,_) <- New.treeModelGetRow rawmodel iter1 - (t2,_) <- New.treeModelGetRow rawmodel iter2 - return (compare t1 t2) - New.treeSortableSetSortFunc model 2 $ \iter1 iter2 -> do - (_,n1) <- New.treeModelGetRow rawmodel iter1 - (_,n2) <- New.treeModelGetRow rawmodel iter2 - return (compare n1 n2) - - -- Create the view. - view <- New.treeViewNewWithModel model - - -- Create and insert two columns, one with the heading Name, one with the - -- heading Number. Associate the 'SortColumnId' 2 with the latter column such - -- that clicking on the Number header will sort the rows by the numbers. - col <- New.treeViewColumnNew - New.treeViewColumnSetTitle col "Name" - rend <- New.cellRendererTextNew - New.cellLayoutPackStart col rend True - New.cellLayoutSetAttributeFunc col rend model $ \iter -> do - cIter <- New.treeModelSortConvertIterToChildIter model iter - (n,_) <- New.treeModelGetRow rawmodel cIter - set rend [New.cellText := n] - New.treeViewAppendColumn view col - - col' <- New.treeViewColumnNew - New.treeViewColumnSetTitle col' "Number" - rend <- New.cellRendererTextNew - New.cellLayoutPackStart col' rend True - New.cellLayoutSetAttributeFunc col' rend model $ \iter -> do - cIter <- New.treeModelSortConvertIterToChildIter model iter - (_,c) <- New.treeModelGetRow rawmodel cIter - set rend [New.cellText := show c] - New.treeViewAppendColumn view col' - New.treeViewColumnSetSortColumnId col' 2 - - -- Create a button that shows information on the current state of the sorting - -- settings. - button <- buttonNewWithLabel "Dump Info" - button `onClicked` do - sId <- New.treeViewColumnGetSortColumnId col - putStrLn ("tvc1 sort id is "++show sId) - sId <- New.treeViewColumnGetSortColumnId col' - putStrLn ("tvc2 sort id is "++show sId) - sId <- New.treeSortableGetSortColumnId model - putStrLn ("sort id is "++show sId) - -- Show all entries of the proxy model - let recurse Nothing = return () - recurse (Just iter) = do - cIter <- New.treeModelSortConvertIterToChildIter model iter - row <- New.treeModelGetRow rawmodel cIter - putStrLn ("iter "++show cIter++": "++show row) - mIter <- New.treeModelIterNext model iter - recurse mIter - mIter <- New.treeModelGetIterFirst model - recurse mIter - - -- Put it all together. - vBox <- vBoxNew False 3 - boxPackStartDefaults vBox view - boxPackEnd vBox button PackNatural 0 - containerAdd win vBox - widgetShowAll win - win `onDestroy` mainQuit - mainGUI diff --git a/demo/treeList/TreeTest.glade b/demo/treeList/TreeTest.glade deleted file mode 100644 --- a/demo/treeList/TreeTest.glade +++ /dev/null @@ -1,1108 +0,0 @@ - - - - - - - True - Tree Test - GTK_WINDOW_TOPLEVEL - GTK_WIN_POS_NONE - False - True - False - True - False - False - GDK_WINDOW_TYPE_HINT_NORMAL - GDK_GRAVITY_NORTH_WEST - True - False - - - - True - False - 0 - - - - True - True - GTK_POLICY_ALWAYS - GTK_POLICY_ALWAYS - GTK_SHADOW_IN - GTK_CORNER_TOP_LEFT - - - - True - True - True - False - False - True - False - False - False - - - - - 0 - True - True - - - - - - 8 - True - False - 12 - - - - True - True - True - 0 - - - - 2 - True - 3 - 2 - False - 4 - 18 - - - - True - True - 1 - 0 - True - GTK_UPDATE_ALWAYS - True - False - 1 0 100 1 10 10 - - - 1 - 2 - 1 - 2 - - - - - - - True - True - GTK_RELIEF_NORMAL - True - False - False - True - - - - - - - 1 - 2 - 2 - 3 - fill - - - - - - - True - True - True - True - 0 - - True - * - False - - - 1 - 2 - 0 - 1 - expand|shrink|fill - - - - - - - True - Number value: - False - False - GTK_JUSTIFY_LEFT - False - False - 1 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - 1 - 1 - 2 - - - - - - - - True - String value: - False - False - GTK_JUSTIFY_LEFT - False - False - 1 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - 1 - 0 - 1 - - - - - - - - True - Boolean value: - False - False - GTK_JUSTIFY_LEFT - False - False - 1 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - 1 - 2 - 3 - - - - - - - - - - True - <b>Value</b> - False - True - GTK_JUSTIFY_LEFT - False - False - 0.5 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - label_item - - - - - 0 - False - False - - - - - - True - True - True - 0 - - - - True - 2 - 3 - False - 4 - 2 - - - - True - True - insert - True - GTK_RELIEF_NORMAL - True - - - 0 - 1 - 0 - 1 - fill - - - - - - - True - new entry at - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 1 - 2 - 0 - 1 - fill - - - - - - - True - True - True - True - 0 - - True - * - False - 10 - - - 2 - 3 - 0 - 1 - - - - - - - True - True - update - True - GTK_RELIEF_NORMAL - True - - - 0 - 1 - 1 - 2 - fill - - - - - - - True - entry at - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 1 - 2 - 1 - 2 - fill - - - - - - - True - True - True - True - 0 - - True - * - False - 10 - - - 2 - 3 - 1 - 2 - - - - - - - - - True - <b>Insert and Update</b> - False - True - GTK_JUSTIFY_LEFT - False - False - 0.5 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - label_item - - - - - 0 - False - False - - - - - - True - True - True - 0 - - - - True - 2 - 3 - False - 4 - 2 - - - - 54 - True - True - delete - True - GTK_RELIEF_NORMAL - True - - - 0 - 1 - 0 - 1 - fill - - - - - - - True - True - clear - True - GTK_RELIEF_NORMAL - True - - - 0 - 1 - 1 - 2 - fill - - - - - - - True - entry - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 1 - 2 - 0 - 1 - fill - - - - - - - True - all - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 1 - 2 - 1 - 2 - fill - - - - - - - True - True - True - True - 0 - - True - * - False - 10 - - - 2 - 3 - 0 - 1 - - - - - - - - - True - <b>Delete</b> - False - True - GTK_JUSTIFY_LEFT - False - False - 0.5 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - label_item - - - - - 0 - False - False - - - - - - True - True - False - 0 - - - - True - 2 - 5 - False - 4 - 2 - - - - 54 - True - True - move - True - GTK_RELIEF_NORMAL - True - - - 0 - 1 - 0 - 1 - fill - - - - - - - 54 - True - True - move - True - GTK_RELIEF_NORMAL - True - - - 0 - 1 - 1 - 2 - fill - - - - - - - True - entry - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 1 - 2 - 0 - 1 - fill - - - - - - - True - entry - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 1 - 2 - 1 - 2 - fill - - - - - - - True - before - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 3 - 4 - 0 - 1 - fill - - - - - - - True - after - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 3 - 4 - 1 - 2 - fill - - - - - - - True - True - True - True - 0 - - True - * - False - 10 - - - 2 - 3 - 0 - 1 - - - - - - - True - True - True - True - 0 - - True - * - False - 10 - - - 4 - 5 - 0 - 1 - - - - - - - True - True - True - True - 0 - - True - * - False - 10 - - - 2 - 3 - 1 - 2 - - - - - - - True - True - True - True - 0 - - True - * - False - 10 - - - 4 - 5 - 1 - 2 - - - - - - - - - True - <b>Move</b> - False - True - GTK_JUSTIFY_LEFT - False - False - 0.5 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - label_item - - - - - 0 - False - False - - - - - - True - True - False - 0 - - - - 4 - True - False - 2 - - - - 54 - True - True - swap - True - GTK_RELIEF_NORMAL - True - - - 0 - False - False - - - - - - True - entry - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - True - - - - - - True - True - True - True - 0 - - True - * - False - 10 - - - 0 - True - True - - - - - - True - with - False - False - GTK_JUSTIFY_LEFT - False - False - 0 - 0.5 - 4 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - 0 - False - True - - - - - - True - True - True - True - 0 - - True - * - False - 10 - - - 0 - True - True - - - - - - - - True - <b>Swap</b> - False - True - GTK_JUSTIFY_LEFT - False - False - 0.5 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - label_item - - - - - 0 - False - False - - - - - - True - True - False - 0 - - - - - - - - True - <b>Reorder</b> - False - True - GTK_JUSTIFY_LEFT - False - False - 0.5 - 0.5 - 0 - 0 - PANGO_ELLIPSIZE_NONE - -1 - False - 0 - - - label_item - - - - - 0 - False - False - - - - - 0 - False - True - - - - - - - diff --git a/demo/treeList/TreeTest.hs b/demo/treeList/TreeTest.hs deleted file mode 100644 --- a/demo/treeList/TreeTest.hs +++ /dev/null @@ -1,115 +0,0 @@ -module Main where - -import Graphics.UI.Gtk -import Graphics.UI.Gtk.Glade -import Graphics.UI.Gtk.ModelView as New - -import qualified Data.Tree as Tree - -data Phone = Phone { name :: String, number :: Int, marked :: Bool } - -main = do - initGUI - Just xml <- xmlNew "TreeTest.glade" - - win <- xmlGetWidget xml castToWindow "window" - onDestroy win mainQuit - - view <- xmlGetWidget xml castToTreeView "view" - - stringValue <- xmlGetWidget xml castToEntry "stringValue" - intValue <- xmlGetWidget xml castToSpinButton "intValue" - boolValue <- xmlGetWidget xml castToCheckButton "boolValue" - - insertButton <- xmlGetWidget xml castToButton "insert" - updateButton <- xmlGetWidget xml castToButton "update" - newPath <- xmlGetWidget xml castToEntry "newPath" - updatePath <- xmlGetWidget xml castToEntry "updatePath" - - removeButton <- xmlGetWidget xml castToButton "remove" - clearButton <- xmlGetWidget xml castToButton "clear" - removePath <- xmlGetWidget xml castToEntry "removePath" - - -- create a new list store - store <- storeImpl - New.treeViewSetModel view store - setupView view store - - let getValues = do - name <- entryGetText stringValue - number <- spinButtonGetValue intValue - marked <- toggleButtonGetActive boolValue - return Phone { - name = name, - number = floor number, - marked = marked - } - - onClicked insertButton $ do - value <- getValues - path <- fmap read $ get newPath entryText - New.treeStoreInsert store (init path) (last path) value - - onClicked updateButton $ do - value <- getValues - path <- fmap read $ get updatePath entryText - New.treeStoreSetValue store path value - - onClicked removeButton $ do - path <- fmap read $ get removePath entryText - New.treeStoreRemove store path - return () - - onClicked clearButton $ New.treeStoreClear store - - New.treeViewSetReorderable view True - - widgetShowAll win - mainGUI - -setupView view model = do - New.treeViewSetHeadersVisible view True - - -- add three columns - col1 <- New.treeViewColumnNew - col2 <- New.treeViewColumnNew - col3 <- New.treeViewColumnNew - - New.treeViewColumnSetTitle col1 "String column" - New.treeViewColumnSetTitle col2 "Int column" - New.treeViewColumnSetTitle col3 "Bool column" - - renderer1 <- New.cellRendererTextNew - renderer2 <- New.cellRendererTextNew - renderer3 <- New.cellRendererToggleNew - - New.cellLayoutPackStart col1 renderer1 True - New.cellLayoutPackStart col2 renderer2 True - New.cellLayoutPackStart col3 renderer3 True - - New.cellLayoutSetAttributes col1 renderer1 model $ \row -> [ New.cellText := name row ] - New.cellLayoutSetAttributes col2 renderer2 model $ \row -> [ New.cellText := show (number row) ] - New.cellLayoutSetAttributes col3 renderer3 model $ \row -> [ New.cellToggleActive := marked row ] - - New.treeViewAppendColumn view col1 - New.treeViewAppendColumn view col2 - New.treeViewAppendColumn view col3 - -storeImpl = - New.treeStoreNew - [Tree.Node { - Tree.rootLabel = Phone { name = "Foo", number = 1, marked = False }, - Tree.subForest = [leafNode Phone { name = "Bar", number = 11, marked = True } - ,leafNode Phone { name = "Baz", number = 12, marked = False }] - }, - Tree.Node { - Tree.rootLabel = Phone { name = "Foo", number = 2, marked = False }, - Tree.subForest = [leafNode Phone { name = "Bar", number = 21, marked = True } - ,leafNode Phone { name = "Baz", number = 22, marked = False }] - }, - Tree.Node { - Tree.rootLabel = Phone { name = "Foo", number = 3, marked = False }, - Tree.subForest = [leafNode Phone { name = "Bar", number = 31, marked = True } - ,leafNode Phone { name = "Baz", number = 32, marked = False }] - }] - where leafNode a = Tree.Node { Tree.rootLabel = a, Tree.subForest = [] } diff --git a/demo/treeList/resListDND/desktop.png b/demo/treeList/resListDND/desktop.png deleted file mode 100644 Binary files a/demo/treeList/resListDND/desktop.png and /dev/null differ diff --git a/demo/treeList/resListDND/laptop.png b/demo/treeList/resListDND/laptop.png deleted file mode 100644 Binary files a/demo/treeList/resListDND/laptop.png and /dev/null differ diff --git a/demo/treeList/resListDND/laptopSmall.png b/demo/treeList/resListDND/laptopSmall.png deleted file mode 100644 Binary files a/demo/treeList/resListDND/laptopSmall.png and /dev/null differ diff --git a/demo/treeList/resListDND/printer.png b/demo/treeList/resListDND/printer.png deleted file mode 100644 Binary files a/demo/treeList/resListDND/printer.png and /dev/null differ diff --git a/demo/treeList/resListDND/server.png b/demo/treeList/resListDND/server.png deleted file mode 100644 Binary files a/demo/treeList/resListDND/server.png and /dev/null differ diff --git a/demo/treeList/resListDND/tower.png b/demo/treeList/resListDND/tower.png deleted file mode 100644 Binary files a/demo/treeList/resListDND/tower.png and /dev/null differ diff --git a/demo/treeList/rgb.txt b/demo/treeList/rgb.txt deleted file mode 100644 --- a/demo/treeList/rgb.txt +++ /dev/null @@ -1,753 +0,0 @@ -! $Xorg: rgb.txt,v 1.3 2000/08/17 19:54:00 cpqbld Exp $ -255 250 250 snow -248 248 255 ghost white -248 248 255 GhostWhite -245 245 245 white smoke -245 245 245 WhiteSmoke -220 220 220 gainsboro -255 250 240 floral white -255 250 240 FloralWhite -253 245 230 old lace -253 245 230 OldLace -250 240 230 linen -250 235 215 antique white -250 235 215 AntiqueWhite -255 239 213 papaya whip -255 239 213 PapayaWhip -255 235 205 blanched almond -255 235 205 BlanchedAlmond -255 228 196 bisque -255 218 185 peach puff -255 218 185 PeachPuff -255 222 173 navajo white -255 222 173 NavajoWhite -255 228 181 moccasin -255 248 220 cornsilk -255 255 240 ivory -255 250 205 lemon chiffon -255 250 205 LemonChiffon -255 245 238 seashell -240 255 240 honeydew -245 255 250 mint cream -245 255 250 MintCream -240 255 255 azure -240 248 255 alice blue -240 248 255 AliceBlue -230 230 250 lavender -255 240 245 lavender blush -255 240 245 LavenderBlush -255 228 225 misty rose -255 228 225 MistyRose -255 255 255 white - 0 0 0 black - 47 79 79 dark slate gray - 47 79 79 DarkSlateGray - 47 79 79 dark slate grey - 47 79 79 DarkSlateGrey -105 105 105 dim gray -105 105 105 DimGray -105 105 105 dim grey -105 105 105 DimGrey -112 128 144 slate gray -112 128 144 SlateGray -112 128 144 slate grey -112 128 144 SlateGrey -119 136 153 light slate gray -119 136 153 LightSlateGray -119 136 153 light slate grey -119 136 153 LightSlateGrey -190 190 190 gray -190 190 190 grey -211 211 211 light grey -211 211 211 LightGrey -211 211 211 light gray -211 211 211 LightGray - 25 25 112 midnight blue - 25 25 112 MidnightBlue - 0 0 128 navy - 0 0 128 navy blue - 0 0 128 NavyBlue -100 149 237 cornflower blue -100 149 237 CornflowerBlue - 72 61 139 dark slate blue - 72 61 139 DarkSlateBlue -106 90 205 slate blue -106 90 205 SlateBlue -123 104 238 medium slate blue -123 104 238 MediumSlateBlue -132 112 255 light slate blue -132 112 255 LightSlateBlue - 0 0 205 medium blue - 0 0 205 MediumBlue - 65 105 225 royal blue - 65 105 225 RoyalBlue - 0 0 255 blue - 30 144 255 dodger blue - 30 144 255 DodgerBlue - 0 191 255 deep sky blue - 0 191 255 DeepSkyBlue -135 206 235 sky blue -135 206 235 SkyBlue -135 206 250 light sky blue -135 206 250 LightSkyBlue - 70 130 180 steel blue - 70 130 180 SteelBlue -176 196 222 light steel blue -176 196 222 LightSteelBlue -173 216 230 light blue -173 216 230 LightBlue -176 224 230 powder blue -176 224 230 PowderBlue -175 238 238 pale turquoise -175 238 238 PaleTurquoise - 0 206 209 dark turquoise - 0 206 209 DarkTurquoise - 72 209 204 medium turquoise - 72 209 204 MediumTurquoise - 64 224 208 turquoise - 0 255 255 cyan -224 255 255 light cyan -224 255 255 LightCyan - 95 158 160 cadet blue - 95 158 160 CadetBlue -102 205 170 medium aquamarine -102 205 170 MediumAquamarine -127 255 212 aquamarine - 0 100 0 dark green - 0 100 0 DarkGreen - 85 107 47 dark olive green - 85 107 47 DarkOliveGreen -143 188 143 dark sea green -143 188 143 DarkSeaGreen - 46 139 87 sea green - 46 139 87 SeaGreen - 60 179 113 medium sea green - 60 179 113 MediumSeaGreen - 32 178 170 light sea green - 32 178 170 LightSeaGreen -152 251 152 pale green -152 251 152 PaleGreen - 0 255 127 spring green - 0 255 127 SpringGreen -124 252 0 lawn green -124 252 0 LawnGreen - 0 255 0 green -127 255 0 chartreuse - 0 250 154 medium spring green - 0 250 154 MediumSpringGreen -173 255 47 green yellow -173 255 47 GreenYellow - 50 205 50 lime green - 50 205 50 LimeGreen -154 205 50 yellow green -154 205 50 YellowGreen - 34 139 34 forest green - 34 139 34 ForestGreen -107 142 35 olive drab -107 142 35 OliveDrab -189 183 107 dark khaki -189 183 107 DarkKhaki -240 230 140 khaki -238 232 170 pale goldenrod -238 232 170 PaleGoldenrod -250 250 210 light goldenrod yellow -250 250 210 LightGoldenrodYellow -255 255 224 light yellow -255 255 224 LightYellow -255 255 0 yellow -255 215 0 gold -238 221 130 light goldenrod -238 221 130 LightGoldenrod -218 165 32 goldenrod -184 134 11 dark goldenrod -184 134 11 DarkGoldenrod -188 143 143 rosy brown -188 143 143 RosyBrown -205 92 92 indian red -205 92 92 IndianRed -139 69 19 saddle brown -139 69 19 SaddleBrown -160 82 45 sienna -205 133 63 peru -222 184 135 burlywood -245 245 220 beige -245 222 179 wheat -244 164 96 sandy brown -244 164 96 SandyBrown -210 180 140 tan -210 105 30 chocolate -178 34 34 firebrick -165 42 42 brown -233 150 122 dark salmon -233 150 122 DarkSalmon -250 128 114 salmon -255 160 122 light salmon -255 160 122 LightSalmon -255 165 0 orange -255 140 0 dark orange -255 140 0 DarkOrange -255 127 80 coral -240 128 128 light coral -240 128 128 LightCoral -255 99 71 tomato -255 69 0 orange red -255 69 0 OrangeRed -255 0 0 red -255 105 180 hot pink -255 105 180 HotPink -255 20 147 deep pink -255 20 147 DeepPink -255 192 203 pink -255 182 193 light pink -255 182 193 LightPink -219 112 147 pale violet red -219 112 147 PaleVioletRed -176 48 96 maroon -199 21 133 medium violet red -199 21 133 MediumVioletRed -208 32 144 violet red -208 32 144 VioletRed -255 0 255 magenta -238 130 238 violet -221 160 221 plum -218 112 214 orchid -186 85 211 medium orchid -186 85 211 MediumOrchid -153 50 204 dark orchid -153 50 204 DarkOrchid -148 0 211 dark violet -148 0 211 DarkViolet -138 43 226 blue violet -138 43 226 BlueViolet -160 32 240 purple -147 112 219 medium purple -147 112 219 MediumPurple -216 191 216 thistle -255 250 250 snow1 -238 233 233 snow2 -205 201 201 snow3 -139 137 137 snow4 -255 245 238 seashell1 -238 229 222 seashell2 -205 197 191 seashell3 -139 134 130 seashell4 -255 239 219 AntiqueWhite1 -238 223 204 AntiqueWhite2 -205 192 176 AntiqueWhite3 -139 131 120 AntiqueWhite4 -255 228 196 bisque1 -238 213 183 bisque2 -205 183 158 bisque3 -139 125 107 bisque4 -255 218 185 PeachPuff1 -238 203 173 PeachPuff2 -205 175 149 PeachPuff3 -139 119 101 PeachPuff4 -255 222 173 NavajoWhite1 -238 207 161 NavajoWhite2 -205 179 139 NavajoWhite3 -139 121 94 NavajoWhite4 -255 250 205 LemonChiffon1 -238 233 191 LemonChiffon2 -205 201 165 LemonChiffon3 -139 137 112 LemonChiffon4 -255 248 220 cornsilk1 -238 232 205 cornsilk2 -205 200 177 cornsilk3 -139 136 120 cornsilk4 -255 255 240 ivory1 -238 238 224 ivory2 -205 205 193 ivory3 -139 139 131 ivory4 -240 255 240 honeydew1 -224 238 224 honeydew2 -193 205 193 honeydew3 -131 139 131 honeydew4 -255 240 245 LavenderBlush1 -238 224 229 LavenderBlush2 -205 193 197 LavenderBlush3 -139 131 134 LavenderBlush4 -255 228 225 MistyRose1 -238 213 210 MistyRose2 -205 183 181 MistyRose3 -139 125 123 MistyRose4 -240 255 255 azure1 -224 238 238 azure2 -193 205 205 azure3 -131 139 139 azure4 -131 111 255 SlateBlue1 -122 103 238 SlateBlue2 -105 89 205 SlateBlue3 - 71 60 139 SlateBlue4 - 72 118 255 RoyalBlue1 - 67 110 238 RoyalBlue2 - 58 95 205 RoyalBlue3 - 39 64 139 RoyalBlue4 - 0 0 255 blue1 - 0 0 238 blue2 - 0 0 205 blue3 - 0 0 139 blue4 - 30 144 255 DodgerBlue1 - 28 134 238 DodgerBlue2 - 24 116 205 DodgerBlue3 - 16 78 139 DodgerBlue4 - 99 184 255 SteelBlue1 - 92 172 238 SteelBlue2 - 79 148 205 SteelBlue3 - 54 100 139 SteelBlue4 - 0 191 255 DeepSkyBlue1 - 0 178 238 DeepSkyBlue2 - 0 154 205 DeepSkyBlue3 - 0 104 139 DeepSkyBlue4 -135 206 255 SkyBlue1 -126 192 238 SkyBlue2 -108 166 205 SkyBlue3 - 74 112 139 SkyBlue4 -176 226 255 LightSkyBlue1 -164 211 238 LightSkyBlue2 -141 182 205 LightSkyBlue3 - 96 123 139 LightSkyBlue4 -198 226 255 SlateGray1 -185 211 238 SlateGray2 -159 182 205 SlateGray3 -108 123 139 SlateGray4 -202 225 255 LightSteelBlue1 -188 210 238 LightSteelBlue2 -162 181 205 LightSteelBlue3 -110 123 139 LightSteelBlue4 -191 239 255 LightBlue1 -178 223 238 LightBlue2 -154 192 205 LightBlue3 -104 131 139 LightBlue4 -224 255 255 LightCyan1 -209 238 238 LightCyan2 -180 205 205 LightCyan3 -122 139 139 LightCyan4 -187 255 255 PaleTurquoise1 -174 238 238 PaleTurquoise2 -150 205 205 PaleTurquoise3 -102 139 139 PaleTurquoise4 -152 245 255 CadetBlue1 -142 229 238 CadetBlue2 -122 197 205 CadetBlue3 - 83 134 139 CadetBlue4 - 0 245 255 turquoise1 - 0 229 238 turquoise2 - 0 197 205 turquoise3 - 0 134 139 turquoise4 - 0 255 255 cyan1 - 0 238 238 cyan2 - 0 205 205 cyan3 - 0 139 139 cyan4 -151 255 255 DarkSlateGray1 -141 238 238 DarkSlateGray2 -121 205 205 DarkSlateGray3 - 82 139 139 DarkSlateGray4 -127 255 212 aquamarine1 -118 238 198 aquamarine2 -102 205 170 aquamarine3 - 69 139 116 aquamarine4 -193 255 193 DarkSeaGreen1 -180 238 180 DarkSeaGreen2 -155 205 155 DarkSeaGreen3 -105 139 105 DarkSeaGreen4 - 84 255 159 SeaGreen1 - 78 238 148 SeaGreen2 - 67 205 128 SeaGreen3 - 46 139 87 SeaGreen4 -154 255 154 PaleGreen1 -144 238 144 PaleGreen2 -124 205 124 PaleGreen3 - 84 139 84 PaleGreen4 - 0 255 127 SpringGreen1 - 0 238 118 SpringGreen2 - 0 205 102 SpringGreen3 - 0 139 69 SpringGreen4 - 0 255 0 green1 - 0 238 0 green2 - 0 205 0 green3 - 0 139 0 green4 -127 255 0 chartreuse1 -118 238 0 chartreuse2 -102 205 0 chartreuse3 - 69 139 0 chartreuse4 -192 255 62 OliveDrab1 -179 238 58 OliveDrab2 -154 205 50 OliveDrab3 -105 139 34 OliveDrab4 -202 255 112 DarkOliveGreen1 -188 238 104 DarkOliveGreen2 -162 205 90 DarkOliveGreen3 -110 139 61 DarkOliveGreen4 -255 246 143 khaki1 -238 230 133 khaki2 -205 198 115 khaki3 -139 134 78 khaki4 -255 236 139 LightGoldenrod1 -238 220 130 LightGoldenrod2 -205 190 112 LightGoldenrod3 -139 129 76 LightGoldenrod4 -255 255 224 LightYellow1 -238 238 209 LightYellow2 -205 205 180 LightYellow3 -139 139 122 LightYellow4 -255 255 0 yellow1 -238 238 0 yellow2 -205 205 0 yellow3 -139 139 0 yellow4 -255 215 0 gold1 -238 201 0 gold2 -205 173 0 gold3 -139 117 0 gold4 -255 193 37 goldenrod1 -238 180 34 goldenrod2 -205 155 29 goldenrod3 -139 105 20 goldenrod4 -255 185 15 DarkGoldenrod1 -238 173 14 DarkGoldenrod2 -205 149 12 DarkGoldenrod3 -139 101 8 DarkGoldenrod4 -255 193 193 RosyBrown1 -238 180 180 RosyBrown2 -205 155 155 RosyBrown3 -139 105 105 RosyBrown4 -255 106 106 IndianRed1 -238 99 99 IndianRed2 -205 85 85 IndianRed3 -139 58 58 IndianRed4 -255 130 71 sienna1 -238 121 66 sienna2 -205 104 57 sienna3 -139 71 38 sienna4 -255 211 155 burlywood1 -238 197 145 burlywood2 -205 170 125 burlywood3 -139 115 85 burlywood4 -255 231 186 wheat1 -238 216 174 wheat2 -205 186 150 wheat3 -139 126 102 wheat4 -255 165 79 tan1 -238 154 73 tan2 -205 133 63 tan3 -139 90 43 tan4 -255 127 36 chocolate1 -238 118 33 chocolate2 -205 102 29 chocolate3 -139 69 19 chocolate4 -255 48 48 firebrick1 -238 44 44 firebrick2 -205 38 38 firebrick3 -139 26 26 firebrick4 -255 64 64 brown1 -238 59 59 brown2 -205 51 51 brown3 -139 35 35 brown4 -255 140 105 salmon1 -238 130 98 salmon2 -205 112 84 salmon3 -139 76 57 salmon4 -255 160 122 LightSalmon1 -238 149 114 LightSalmon2 -205 129 98 LightSalmon3 -139 87 66 LightSalmon4 -255 165 0 orange1 -238 154 0 orange2 -205 133 0 orange3 -139 90 0 orange4 -255 127 0 DarkOrange1 -238 118 0 DarkOrange2 -205 102 0 DarkOrange3 -139 69 0 DarkOrange4 -255 114 86 coral1 -238 106 80 coral2 -205 91 69 coral3 -139 62 47 coral4 -255 99 71 tomato1 -238 92 66 tomato2 -205 79 57 tomato3 -139 54 38 tomato4 -255 69 0 OrangeRed1 -238 64 0 OrangeRed2 -205 55 0 OrangeRed3 -139 37 0 OrangeRed4 -255 0 0 red1 -238 0 0 red2 -205 0 0 red3 -139 0 0 red4 -255 20 147 DeepPink1 -238 18 137 DeepPink2 -205 16 118 DeepPink3 -139 10 80 DeepPink4 -255 110 180 HotPink1 -238 106 167 HotPink2 -205 96 144 HotPink3 -139 58 98 HotPink4 -255 181 197 pink1 -238 169 184 pink2 -205 145 158 pink3 -139 99 108 pink4 -255 174 185 LightPink1 -238 162 173 LightPink2 -205 140 149 LightPink3 -139 95 101 LightPink4 -255 130 171 PaleVioletRed1 -238 121 159 PaleVioletRed2 -205 104 137 PaleVioletRed3 -139 71 93 PaleVioletRed4 -255 52 179 maroon1 -238 48 167 maroon2 -205 41 144 maroon3 -139 28 98 maroon4 -255 62 150 VioletRed1 -238 58 140 VioletRed2 -205 50 120 VioletRed3 -139 34 82 VioletRed4 -255 0 255 magenta1 -238 0 238 magenta2 -205 0 205 magenta3 -139 0 139 magenta4 -255 131 250 orchid1 -238 122 233 orchid2 -205 105 201 orchid3 -139 71 137 orchid4 -255 187 255 plum1 -238 174 238 plum2 -205 150 205 plum3 -139 102 139 plum4 -224 102 255 MediumOrchid1 -209 95 238 MediumOrchid2 -180 82 205 MediumOrchid3 -122 55 139 MediumOrchid4 -191 62 255 DarkOrchid1 -178 58 238 DarkOrchid2 -154 50 205 DarkOrchid3 -104 34 139 DarkOrchid4 -155 48 255 purple1 -145 44 238 purple2 -125 38 205 purple3 - 85 26 139 purple4 -171 130 255 MediumPurple1 -159 121 238 MediumPurple2 -137 104 205 MediumPurple3 - 93 71 139 MediumPurple4 -255 225 255 thistle1 -238 210 238 thistle2 -205 181 205 thistle3 -139 123 139 thistle4 - 0 0 0 gray0 - 0 0 0 grey0 - 3 3 3 gray1 - 3 3 3 grey1 - 5 5 5 gray2 - 5 5 5 grey2 - 8 8 8 gray3 - 8 8 8 grey3 - 10 10 10 gray4 - 10 10 10 grey4 - 13 13 13 gray5 - 13 13 13 grey5 - 15 15 15 gray6 - 15 15 15 grey6 - 18 18 18 gray7 - 18 18 18 grey7 - 20 20 20 gray8 - 20 20 20 grey8 - 23 23 23 gray9 - 23 23 23 grey9 - 26 26 26 gray10 - 26 26 26 grey10 - 28 28 28 gray11 - 28 28 28 grey11 - 31 31 31 gray12 - 31 31 31 grey12 - 33 33 33 gray13 - 33 33 33 grey13 - 36 36 36 gray14 - 36 36 36 grey14 - 38 38 38 gray15 - 38 38 38 grey15 - 41 41 41 gray16 - 41 41 41 grey16 - 43 43 43 gray17 - 43 43 43 grey17 - 46 46 46 gray18 - 46 46 46 grey18 - 48 48 48 gray19 - 48 48 48 grey19 - 51 51 51 gray20 - 51 51 51 grey20 - 54 54 54 gray21 - 54 54 54 grey21 - 56 56 56 gray22 - 56 56 56 grey22 - 59 59 59 gray23 - 59 59 59 grey23 - 61 61 61 gray24 - 61 61 61 grey24 - 64 64 64 gray25 - 64 64 64 grey25 - 66 66 66 gray26 - 66 66 66 grey26 - 69 69 69 gray27 - 69 69 69 grey27 - 71 71 71 gray28 - 71 71 71 grey28 - 74 74 74 gray29 - 74 74 74 grey29 - 77 77 77 gray30 - 77 77 77 grey30 - 79 79 79 gray31 - 79 79 79 grey31 - 82 82 82 gray32 - 82 82 82 grey32 - 84 84 84 gray33 - 84 84 84 grey33 - 87 87 87 gray34 - 87 87 87 grey34 - 89 89 89 gray35 - 89 89 89 grey35 - 92 92 92 gray36 - 92 92 92 grey36 - 94 94 94 gray37 - 94 94 94 grey37 - 97 97 97 gray38 - 97 97 97 grey38 - 99 99 99 gray39 - 99 99 99 grey39 -102 102 102 gray40 -102 102 102 grey40 -105 105 105 gray41 -105 105 105 grey41 -107 107 107 gray42 -107 107 107 grey42 -110 110 110 gray43 -110 110 110 grey43 -112 112 112 gray44 -112 112 112 grey44 -115 115 115 gray45 -115 115 115 grey45 -117 117 117 gray46 -117 117 117 grey46 -120 120 120 gray47 -120 120 120 grey47 -122 122 122 gray48 -122 122 122 grey48 -125 125 125 gray49 -125 125 125 grey49 -127 127 127 gray50 -127 127 127 grey50 -130 130 130 gray51 -130 130 130 grey51 -133 133 133 gray52 -133 133 133 grey52 -135 135 135 gray53 -135 135 135 grey53 -138 138 138 gray54 -138 138 138 grey54 -140 140 140 gray55 -140 140 140 grey55 -143 143 143 gray56 -143 143 143 grey56 -145 145 145 gray57 -145 145 145 grey57 -148 148 148 gray58 -148 148 148 grey58 -150 150 150 gray59 -150 150 150 grey59 -153 153 153 gray60 -153 153 153 grey60 -156 156 156 gray61 -156 156 156 grey61 -158 158 158 gray62 -158 158 158 grey62 -161 161 161 gray63 -161 161 161 grey63 -163 163 163 gray64 -163 163 163 grey64 -166 166 166 gray65 -166 166 166 grey65 -168 168 168 gray66 -168 168 168 grey66 -171 171 171 gray67 -171 171 171 grey67 -173 173 173 gray68 -173 173 173 grey68 -176 176 176 gray69 -176 176 176 grey69 -179 179 179 gray70 -179 179 179 grey70 -181 181 181 gray71 -181 181 181 grey71 -184 184 184 gray72 -184 184 184 grey72 -186 186 186 gray73 -186 186 186 grey73 -189 189 189 gray74 -189 189 189 grey74 -191 191 191 gray75 -191 191 191 grey75 -194 194 194 gray76 -194 194 194 grey76 -196 196 196 gray77 -196 196 196 grey77 -199 199 199 gray78 -199 199 199 grey78 -201 201 201 gray79 -201 201 201 grey79 -204 204 204 gray80 -204 204 204 grey80 -207 207 207 gray81 -207 207 207 grey81 -209 209 209 gray82 -209 209 209 grey82 -212 212 212 gray83 -212 212 212 grey83 -214 214 214 gray84 -214 214 214 grey84 -217 217 217 gray85 -217 217 217 grey85 -219 219 219 gray86 -219 219 219 grey86 -222 222 222 gray87 -222 222 222 grey87 -224 224 224 gray88 -224 224 224 grey88 -227 227 227 gray89 -227 227 227 grey89 -229 229 229 gray90 -229 229 229 grey90 -232 232 232 gray91 -232 232 232 grey91 -235 235 235 gray92 -235 235 235 grey92 -237 237 237 gray93 -237 237 237 grey93 -240 240 240 gray94 -240 240 240 grey94 -242 242 242 gray95 -242 242 242 grey95 -245 245 245 gray96 -245 245 245 grey96 -247 247 247 gray97 -247 247 247 grey97 -250 250 250 gray98 -250 250 250 grey98 -252 252 252 gray99 -252 252 252 grey99 -255 255 255 gray100 -255 255 255 grey100 -169 169 169 dark grey -169 169 169 DarkGrey -169 169 169 dark gray -169 169 169 DarkGray -0 0 139 dark blue -0 0 139 DarkBlue -0 139 139 dark cyan -0 139 139 DarkCyan -139 0 139 dark magenta -139 0 139 DarkMagenta -139 0 0 dark red -139 0 0 DarkRed -144 238 144 light green -144 238 144 LightGreen diff --git a/demo/treelist/Completion.hs b/demo/treelist/Completion.hs new file mode 100644 --- /dev/null +++ b/demo/treelist/Completion.hs @@ -0,0 +1,81 @@ +-- Demo to show off entry completion. + +import Graphics.UI.Gtk +import Data.Char +import Data.List + +data ColorDesc = ColorDesc { + cdColor :: Color, + cdName :: String + } deriving Show + +compareCol :: ColumnId ColorDesc String +compareCol = makeColumnIdString 0 + +invertColor (Color r g b) = Color (32767+r) (32767+g) (32767+b) +--Color (65535-r) (65535-g) (65535-b) + +parseColor s = ColorDesc c (dropWhile isSpace (upperToSpace name)) + where + s1 = dropWhile isSpace s + (s2,s3) = span isDigit s1 + s4 = dropWhile isSpace s3 + (s5,s6) = span isDigit s4 + s7 = dropWhile isSpace s6 + (s8,s9) = span isDigit s7 + n1 = read ('0':s2) + n2 = read ('0':s5) + n3 = read ('0':s8) + c = Color (n1*256+n1) (n2*256+n2) (n3*256+n3) + name = dropWhile isSpace s9 + upperToSpace [] = [] + upperToSpace (x:xs) | isUpper x = ' ':toLower x:upperToSpace xs + | otherwise = x:upperToSpace xs + +main = + do + initGUI + window <- windowNew + + contents <- readFile "rgb.txt" + let killDups [] = [] + killDups [x] = [x] + killDups (x:y:xs) | cdName x==cdName y = killDups (y:xs) + | otherwise = x:killDups (y:xs) + cols = killDups $ map parseColor (drop 1 (lines contents)) + store <- listStoreNew cols + customStoreSetColumn store compareCol cdName + + entry <- entryNew + completion <- entryCompletionNew + entrySetCompletion entry completion + + set completion [entryCompletionModel := Just store] + cell <- cellRendererTextNew + set cell [cellTextBackgroundSet := True, + cellTextForegroundSet := True] + cellLayoutPackStart completion cell True + cellLayoutSetAttributes completion cell store + (\cd -> [cellText := cdName cd, + cellTextBackgroundColor := cdColor cd, + cellTextForegroundColor := invertColor (cdColor cd)]) + entryCompletionSetMatchFunc completion (matchFunc store) + on completion matchSelected $ \model iter -> do + color <- treeModelGetValue model iter compareCol + entrySetText entry color + return True + set window [containerChild := entry] + widgetShowAll window + onDestroy window mainQuit + mainGUI + +matchFunc :: ListStore ColorDesc -> String -> TreeIter -> IO Bool +matchFunc model str iter = do + --putStrLn ("iter is "++show iter) + tp <- treeModelGetPath model iter + r <- case tp of + (i:_) -> do row <- listStoreGetValue model i + return $ any (isPrefixOf (map toLower str)) + (words (map toLower (cdName row))) + otherwise -> return False + return r diff --git a/demo/treelist/DirList.hs b/demo/treelist/DirList.hs new file mode 100644 --- /dev/null +++ b/demo/treelist/DirList.hs @@ -0,0 +1,82 @@ +{-# OPTIONS -cpp #-} +-- Test file for the ListView widget. +module Main(main) where + +import Graphics.UI.Gtk +import Graphics.UI.Gtk.ModelView as New + +import Control.Exception +import System.Directory +import System.IO +import System.Locale +import System.Time + +data FileInfo = FileInfo { + fName :: String, + fSize :: Integer, + fTime :: ClockTime +} + +main = do + initGUI + win <- windowNew + win `onDestroy` mainQuit + + curDir <- getCurrentDirectory + files <- getDirectoryContents curDir + fInfos <- (flip mapM) files $ \f -> do + s <- handle (\e -> +#if __GLASGOW_HASKELL__>=610 + case e :: SomeException of + e -> +#endif + return 0) $ do + h <- openFile f ReadMode + s <- hFileSize h + hClose h + return s + t <- getModificationTime f + return FileInfo { fName = f + , fSize = s + , fTime = t } + + store <- New.listStoreNew fInfos + + tv <- New.treeViewNewWithModel store + containerAdd win tv + + tvc <- New.treeViewColumnNew + set tvc [ New.treeViewColumnTitle := "File name" + , New.treeViewColumnResizable := True ] + New.treeViewAppendColumn tv tvc + + name <- New.cellRendererTextNew + New.treeViewColumnPackStart tvc name True + New.cellLayoutSetAttributes tvc name store $ \FileInfo { fName = name } -> + [ New.cellText := name ] + + tvc <- New.treeViewColumnNew + set tvc [ New.treeViewColumnTitle := "Size" + , New.treeViewColumnResizable := True ] + New.treeViewAppendColumn tv tvc + + size <- New.cellRendererTextNew + New.treeViewColumnPackStart tvc size True + New.cellLayoutSetAttributes tvc size store $ \FileInfo { fSize = size } -> + [ New.cellText := show size ] + + tvc <- New.treeViewColumnNew + set tvc [ New.treeViewColumnTitle := "Modification time" + , New.treeViewColumnResizable := True ] + New.treeViewAppendColumn tv tvc + + time <- New.cellRendererTextNew + New.treeViewColumnPackStart tvc time True + New.cellLayoutSetAttributes tvc time store $ \FileInfo { fTime = time } -> + [ New.cellText :=> do + calTime <- toCalendarTime time + return (formatCalendarTime defaultTimeLocale "%D %T" calTime) + ] + + widgetShowAll win + mainGUI diff --git a/demo/treelist/FilterDemo.hs b/demo/treelist/FilterDemo.hs new file mode 100644 --- /dev/null +++ b/demo/treelist/FilterDemo.hs @@ -0,0 +1,71 @@ +-- a demo that shows how to create a normal tree view and a tree view in +-- which only a chosen subset of rows are shown (namely those with upper case letters) +module Main ( main ) where + +import Graphics.UI.Gtk +import Data.List +import Data.Char +import Debug.Trace + +-- | Define a virtual column of the model that determines the visibility of a row in +-- the model. +visCol :: ColumnId String Bool +visCol = makeColumnIdBool 0 + +main = do + initGUI + + win <- windowNew + onDestroy win mainQuit + + content <- readFile "FilterDemo.hs" + + -- create a view that shows all lines + model <- listStoreNew (lines content) + viewAll <- treeViewNewWithModel model + col <- treeViewColumnNew + ren <- cellRendererTextNew + cellLayoutPackStart col ren True + cellLayoutSetAttributes col ren model $ \row -> [ cellText := row ] + treeViewAppendColumn viewAll col + + -- create a view that only shows lines with upper case characters + fModel <- treeModelFilterNew model [] + + -- create a virtual column 'visCol' that contains @True@ if a certain row has + -- upper case letters. Then set this column to determine the visibility of a row. + customStoreSetColumn model visCol (any isUpper) + treeModelFilterSetVisibleColumn fModel visCol + +{- + -- this is an alternative way to determine the visibility of a row. In this case, + -- it is not necessary to create the column 'visCol'. + treeModelFilterSetVisibleFunc fModel $ Just $ \iter -> do + row <- treeModelGetRow model iter + return (any isUpper row) +-} + -- note: it is important to insert the model into the view after the visibility + -- row or the visibility function have been set. Otherwise, the view is filled + -- first and setting a new visibility column/function will not update the view. + viewFew <- treeViewNewWithModel fModel + col <- treeViewColumnNew + ren <- cellRendererTextNew + cellLayoutPackStart col ren True + cellLayoutSetAttributes col ren model $ \row -> [ cellText := row ] + + treeViewAppendColumn viewFew col + + + + box <- vBoxNew False 0 + swAll <- scrolledWindowNew Nothing Nothing + containerAdd swAll viewAll + boxPackStart box swAll PackGrow 4 + + swFew <- scrolledWindowNew Nothing Nothing + containerAdd swFew viewFew + boxPackEnd box swFew PackGrow 4 + + containerAdd win box + widgetShowAll win + mainGUI diff --git a/demo/treelist/ListDND.hs b/demo/treelist/ListDND.hs new file mode 100644 --- /dev/null +++ b/demo/treelist/ListDND.hs @@ -0,0 +1,248 @@ +module Main where + +import Graphics.UI.Gtk +import Graphics.UI.Gtk.Gdk.EventM + +import System.Glib.GObject ( toGObject ) +import System.FilePath +import Control.Concurrent.MVar +import Control.Monad ( liftM ) +import Control.Monad.Trans ( liftIO ) +import Data.Maybe ( fromMaybe ) +import Data.List ( findIndex ) + +roomStrCol :: ColumnId String String +roomStrCol = makeColumnIdString 1 + +-- Define a string column and an image column on the store holding the +-- computer types. +compPicCol :: ColumnId CompType Pixbuf +compPicCol = makeColumnIdPixbuf 1 + +compStrCol :: ColumnId CompType String +compStrCol = makeColumnIdString 2 + +data Computer = Computer { + name :: String, + addr :: (Int, Int, Int, Int), + roomStore :: ListStore String, + roomSel :: Int, + cType :: CompType } + +data CompType + = MacBookPro + | MacBook + | Printer + | MacPro + | Xserve + | IMac + deriving (Enum, Bounded, Show) + +showCT :: CompType -> String +showCT ct = case show ct of + 'I':xs -> 'i':xs + xs -> xs + +main = do + initGUI + + win <- windowNew + onDestroy win mainQuit + + -- create a tag that we use as selection, target and selection type + compTypeTag <- atomNew "_CompType" + + let pNames = map ("resListDND" ) + ["laptop.png","laptopSmall.png","printer.png", + "tower.png","server.png","desktop.png"] + pics <- mapM pixbufNewFromFile pNames + + smallPics <- mapM (\n -> pixbufNewFromFileAtScale n 48 48 True) pNames + + [noRoom, publicRoom, restrictedRoom] <- mapM listStoreNew + [["Paul (Home)","John (Home)","Fred (Home)"], + ["N12","S112", "S113", "S114"], + ["Server Room Upstairs", "Server Room Downstairs"]] + + -- define extractor function for the string column + treeModelSetColumn noRoom roomStrCol id + treeModelSetColumn publicRoom roomStrCol id + treeModelSetColumn restrictedRoom roomStrCol id + + let genRoomStore MacBookPro = noRoom + genRoomStore MacBook = noRoom + genRoomStore Printer = publicRoom + genRoomStore MacPro = publicRoom + genRoomStore Xserve = restrictedRoom + genRoomStore IMac = publicRoom + + -- the initial computer list - it's a coincidence that there's + -- one computer of each type + content <- listStoreNewDND + (map (\t -> Computer { name = showCT t, addr = (192,168,0,fromEnum t+1), + roomStore = genRoomStore t, roomSel = 0, cType = t}) + [minBound :: CompType .. maxBound]) + (Just listStoreDefaultDragSourceIface) + (Just DragDestIface { + treeDragDestRowDropPossible = \store path@(i:_) -> do + mCT <- selectionDataGet compTypeTag + case mCT :: Maybe [Int] of + Just [ct] -> return True + Nothing -> + (treeDragDestRowDropPossible listStoreDefaultDragDestIface) + store path + _ -> return False, + treeDragDestDragDataReceived = \store path@(i:_) -> do + mCT <- selectionDataGet compTypeTag + case mCT of + Just [ct] -> do + let t = toEnum ct + liftIO $ listStoreInsert store i + Computer { name = showCT t, addr = (192,168,0,254), + roomStore = genRoomStore t, roomSel = 0, + cType = t } + return True + Nothing -> + (treeDragDestDragDataReceived listStoreDefaultDragDestIface) + store path + }) + -- the area with the possible computer types + compTypes <- listStoreNewDND [minBound :: CompType .. maxBound] + (Just DragSourceIface { + treeDragSourceRowDraggable = \store (i:_) -> return True, + treeDragSourceDragDataGet = \store (i:_) -> do + ty <- selectionDataGetTarget + ct <- liftIO $ listStoreGetValue store i + selectionDataSet compTypeTag [fromEnum ct] + return True, + treeDragSourceDragDataDelete = \store path -> return True + }) + Nothing + + -- define extractor functions for the two column + treeModelSetColumn compTypes compPicCol $ + \t -> pics !! fromEnum t + treeModelSetColumn compTypes compStrCol showCT + + -- create an icon view of all the computer types + typesView <- iconViewNew + set typesView [iconViewModel := Just compTypes, + iconViewPixbufColumn := compPicCol, + iconViewTextColumn := compStrCol, + iconViewColumns := 6] + + -- create an editable list of computers + inventory <- treeViewNewWithModel content + + tyCol <- treeViewColumnNew + treeViewColumnSetTitle tyCol "Type" + picRen <- cellRendererPixbufNew + treeViewColumnPackStart tyCol picRen False + cellLayoutSetAttributes tyCol picRen content + (\Computer { cType = t} -> [cellPixbuf := smallPics !! fromEnum t]) + tyRen <- cellRendererTextNew + treeViewColumnPackStart tyCol tyRen False + cellLayoutSetAttributes tyCol tyRen content + (\Computer { cType = t} -> [cellText := showCT t]) + treeViewAppendColumn inventory tyCol + + nameCol <- treeViewColumnNew + treeViewColumnSetTitle nameCol "Name" + treeViewColumnSetResizable nameCol True + treeViewColumnSetMinWidth nameCol 100 + nameRen <- cellRendererTextNew + set nameRen [ cellTextEditable := True, + cellTextEditableSet := True, + cellTextEllipsize := EllipsizeEnd, + cellTextEllipsizeSet := True] + treeViewColumnPackStart nameCol nameRen True + cellLayoutSetAttributes nameCol nameRen content + (\Computer { name = n } -> [cellText := n]) + treeViewAppendColumn inventory nameCol + on nameRen edited $ \[i] str -> do + val <- listStoreGetValue content i + listStoreSetValue content i val { name = str } + + addrCol <- treeViewColumnNew + treeViewColumnSetTitle addrCol "Address" + oct1 <- cellRendererTextNew + dot1 <- cellRendererTextNew + oct2 <- cellRendererTextNew + dot2 <- cellRendererTextNew + oct3 <- cellRendererTextNew + dot3 <- cellRendererTextNew + oct4 <- cellRendererTextNew + mapM_ (uncurry (cellLayoutPackStart addrCol)) + [(oct1, True), (dot1, False), (oct2, True), + (dot2, False), (oct3, True), (dot3, False), (oct4, True)] + mapM_ (\d -> set d [cellText := ".", + cellTextWidthChars := 0]) [dot1, dot2, dot3] + mapM_ (\o -> set o [cellXAlign := 1.0, + cellTextWidthChars := 3]) [oct1, oct2, oct3, oct4] + cellLayoutSetAttributes addrCol oct1 content + (\Computer { addr = (o1,_,_,_)} -> [cellText := show o1]) + cellLayoutSetAttributes addrCol oct2 content + (\Computer { addr = (_,o2,_,_)} -> [cellText := show o2]) + cellLayoutSetAttributes addrCol oct3 content + (\Computer { addr = (_,_,o3,_)} -> [cellText := show o3]) + cellLayoutSetAttributes addrCol oct4 content + (\Computer { addr = (_,_,_,o4)} -> [cellText := show o4]) + treeViewAppendColumn inventory addrCol + + roomCol <- treeViewColumnNew + treeViewColumnSetTitle roomCol "Room" + treeViewColumnSetResizable roomCol True + treeViewColumnSetSizing roomCol TreeViewColumnAutosize + roomRen <- cellRendererComboNew + set roomRen [ cellTextEditable := True, + cellTextEditableSet := True, + cellComboHasEntry := True ] + treeViewColumnPackStart roomCol roomRen True + cellLayoutSetAttributes roomCol roomRen content + (\Computer { roomStore = t, roomSel = idx } -> + [cellText :=> listStoreGetValue t idx, + cellComboTextModel := (t, roomStrCol)]) + on roomRen edited $ \[i] str -> do + row@Computer { roomStore = t } <- listStoreGetValue content i + elems <- listStoreToList t + idx <- case (findIndex ((==) str) elems) of + Just idx -> return idx + Nothing -> listStoreAppend t str + listStoreSetValue content i row { roomSel = idx } + treeViewAppendColumn inventory roomCol + + -- make typesView a drag source for compTypeTag values + tl <- targetListNew + targetListAdd tl compTypeTag [TargetSameApp] 0 + iconViewEnableModelDragSource typesView [Button1] tl [ActionCopy] + + -- Due to a bug in Gtk+, the treeDragSourceDragDataGet handler in + -- the DND source handler is not called unless the IconView is also + -- set to be a DND destination. Bugzilla 550528 + tl <- targetListNew + iconViewEnableModelDragDest typesView tl [] + + -- make the inventory widget a drag destination for compTypeTag values + tl <- targetListNew + targetListAdd tl compTypeTag [TargetSameApp] 0 + targetListAdd tl targetTreeModelRow [TargetSameWidget] 0 + treeViewEnableModelDragDest inventory tl [ActionMove] + tl <- targetListNew + targetListAdd tl targetTreeModelRow [TargetSameWidget] 0 + treeViewEnableModelDragSource inventory [Button1] tl [ActionMove] + + -- Install drag and drop for permuting rows. This is now done above using + -- the explicit target 'targetTreeModelRow'. Calling the function below + -- will set a completely new 'TargetList' thereby removing our own + -- 'compTypeTag' from the inventory widget's target list. + + --treeViewSetReorderable inventory True + + -- arrange the widgets + v <- vPanedNew + panedAdd1 v typesView + panedAdd2 v inventory + containerAdd win v + + widgetShowAll win + mainGUI diff --git a/demo/treelist/ListDemo.hs b/demo/treelist/ListDemo.hs new file mode 100644 --- /dev/null +++ b/demo/treelist/ListDemo.hs @@ -0,0 +1,66 @@ +module Main where + +import Graphics.UI.Gtk +import System.Glib.Signals (on) +import Data.List ( isPrefixOf ) +import Data.Char ( toLower ) + +data Phone = Phone { name :: String, number :: Int, marked :: Bool } + +main = do + initGUI + + win <- windowNew + onDestroy win mainQuit + + -- create a new list model + model <- listStoreNew + [Phone { name = "Foo", number = 12345, marked = False } + ,Phone { name = "Bar", number = 67890, marked = True } + ,Phone { name = "Baz", number = 39496, marked = False }] + view <- treeViewNewWithModel model + + treeViewSetHeadersVisible view True + + -- add a couple columns + col1 <- treeViewColumnNew + col2 <- treeViewColumnNew + col3 <- treeViewColumnNew + + treeViewColumnSetTitle col1 "String column" + treeViewColumnSetTitle col2 "Int column" + treeViewColumnSetTitle col3 "Bool column" + + renderer1 <- cellRendererTextNew + renderer2 <- cellRendererTextNew + renderer3 <- cellRendererToggleNew + + cellLayoutPackStart col1 renderer1 True + cellLayoutPackStart col2 renderer2 True + cellLayoutPackStart col3 renderer3 True + + cellLayoutSetAttributes col1 renderer1 model $ \row -> [ cellText := name row ] + cellLayoutSetAttributes col2 renderer2 model $ \row -> [ cellText := show (number row) ] + cellLayoutSetAttributes col3 renderer3 model $ \row -> [ cellToggleActive := marked row ] + + treeViewAppendColumn view col1 + treeViewAppendColumn view col2 + treeViewAppendColumn view col3 + + -- update the model when the toggle buttons are activated + on renderer3 cellToggled $ \pathStr -> do + let (i:_) = stringToTreePath pathStr + val <- listStoreGetValue model i + listStoreSetValue model i val { marked = not (marked val) } + + + -- enable interactive search + treeViewSetEnableSearch view True + treeViewSetSearchEqualFunc view $ Just $ \str iter -> do + (i:_) <- treeModelGetPath model iter + row <- listStoreGetValue model i + return (map toLower str `isPrefixOf` map toLower (name row)) + + containerAdd win view + widgetShowAll win + mainGUI diff --git a/demo/treelist/ListTest.glade b/demo/treelist/ListTest.glade new file mode 100644 --- /dev/null +++ b/demo/treelist/ListTest.glade @@ -0,0 +1,1404 @@ + + + + + + + True + List Test + GTK_WINDOW_TOPLEVEL + GTK_WIN_POS_NONE + False + True + False + True + False + False + GDK_WINDOW_TYPE_HINT_NORMAL + GDK_GRAVITY_NORTH_WEST + True + + + + True + False + 0 + + + + True + True + GTK_POLICY_ALWAYS + GTK_POLICY_ALWAYS + GTK_SHADOW_IN + GTK_CORNER_TOP_LEFT + + + + True + True + True + False + False + True + False + False + False + + + + + 0 + True + True + + + + + + True + False + 0 + + + + 8 + True + False + 12 + + + + True + True + True + 0 + + + + 2 + True + 3 + 2 + False + 2 + 18 + + + + True + True + 1 + 0 + True + GTK_UPDATE_ALWAYS + True + False + 1 0 100 1 10 10 + + + 1 + 2 + 1 + 2 + + + + + + + True + True + GTK_RELIEF_NORMAL + True + False + False + True + + + 1 + 2 + 2 + 3 + fill + + + + + + + True + String value: + False + False + GTK_JUSTIFY_LEFT + False + False + 1 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + 1 + 0 + 1 + + + + + + + True + Number value: + False + False + GTK_JUSTIFY_LEFT + False + False + 1 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + 1 + 1 + 2 + + + + + + + True + Boolean value: + False + False + GTK_JUSTIFY_LEFT + False + False + 1 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + 1 + 2 + 3 + + + + + + + True + True + True + True + 0 + + True + * + False + + + 1 + 2 + 0 + 1 + expand|shrink|fill + + + + + + + + + True + <b>Value</b> + False + True + GTK_JUSTIFY_LEFT + False + False + 0.5 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + label_item + + + + + 0 + False + False + + + + + + True + True + True + 0 + + + + 4 + True + False + 2 + + + + True + True + 0 + + + + True + True + insert + True + GTK_RELIEF_NORMAL + True + + + 0 + True + True + + + + + + True + new entry at + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + True + + + + + + True + True + 1 + 0 + False + GTK_UPDATE_ALWAYS + False + False + 1 0 100 1 10 10 + + + 4 + False + False + + + + + 0 + True + True + + + + + + True + True + 0 + + + + True + True + prepend + True + GTK_RELIEF_NORMAL + True + + + 0 + True + True + + + + + + True + new entry + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + True + + + + + + True + + False + False + GTK_JUSTIFY_LEFT + False + False + 0.5 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + False + + + + + 0 + True + True + + + + + + True + True + 0 + + + + True + True + append + True + GTK_RELIEF_NORMAL + True + + + 0 + True + True + + + + + + True + new entry + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + True + + + + + + True + + False + False + GTK_JUSTIFY_LEFT + False + False + 0.5 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + False + + + + + 0 + True + True + + + + + + True + True + 0 + + + + True + True + update + True + GTK_RELIEF_NORMAL + True + + + 0 + True + True + + + + + + True + entry + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + True + + + + + + True + True + 1 + 0 + False + GTK_UPDATE_ALWAYS + False + False + 1 0 100 1 10 10 + + + 0 + False + False + + + + + 0 + True + True + + + + + + + + True + <b>Insert and Update</b> + False + True + GTK_JUSTIFY_LEFT + False + False + 0.5 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + label_item + + + + + 0 + False + False + + + + + + True + True + True + 0 + + + + True + False + 2 + + + + 4 + True + True + 0 + + + + 54 + True + True + delete + True + GTK_RELIEF_NORMAL + True + + + 0 + False + False + + + + + + True + entry + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + True + + + + + + True + True + 1 + 0 + False + GTK_UPDATE_ALWAYS + False + False + 1 0 100 1 10 10 + + + 0 + False + False + + + + + + True + + False + False + GTK_JUSTIFY_LEFT + False + False + 0.5 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + False + + + + + + True + + False + False + GTK_JUSTIFY_LEFT + False + False + 0.5 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + False + + + + + 0 + True + True + + + + + + 4 + True + True + 0 + + + + True + True + clear + True + GTK_RELIEF_NORMAL + True + + + 0 + False + True + + + + + + True + all + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + True + + + + + + True + + False + False + GTK_JUSTIFY_LEFT + False + False + 0.5 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + False + + + + + + True + + False + False + GTK_JUSTIFY_LEFT + False + False + 0.5 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + False + + + + + + True + + False + False + GTK_JUSTIFY_LEFT + False + False + 0.5 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + False + + + + + 0 + True + True + + + + + + + + True + <b>Delete</b> + False + True + GTK_JUSTIFY_LEFT + False + False + 0.5 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + label_item + + + + + 0 + False + False + + + + + + True + True + False + 0 + + + + 4 + True + False + 2 + + + + True + True + 0 + + + + 54 + True + True + move + True + GTK_RELIEF_NORMAL + True + + + 0 + False + False + + + + + + True + entry + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + True + + + + + + True + True + 1 + 0 + False + GTK_UPDATE_ALWAYS + False + False + 1 0 100 1 10 10 + + + 0 + True + False + + + + + + True + before + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + True + + + + + + True + True + 1 + 0 + False + GTK_UPDATE_ALWAYS + False + False + 1 0 100 1 10 10 + + + 0 + True + False + + + + + 0 + False + False + + + + + + True + True + 0 + + + + 54 + True + True + move + True + GTK_RELIEF_NORMAL + True + + + 0 + False + False + + + + + + True + entry + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + True + + + + + + True + True + 1 + 0 + False + GTK_UPDATE_ALWAYS + False + False + 1 0 100 1 10 10 + + + 0 + True + False + + + + + + True + after + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + True + + + + + + True + True + 1 + 0 + False + GTK_UPDATE_ALWAYS + False + False + 1 0 100 1 10 10 + + + 0 + True + False + + + + + 0 + False + False + + + + + + + + True + <b>Move</b> + False + True + GTK_JUSTIFY_LEFT + False + False + 0.5 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + label_item + + + + + 0 + False + False + + + + + + True + True + False + 0 + + + + 4 + True + True + 0 + + + + 54 + True + True + swap + True + GTK_RELIEF_NORMAL + True + + + 0 + False + False + + + + + + True + entry + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + True + + + + + + True + True + 1 + 0 + False + GTK_UPDATE_ALWAYS + False + False + 1 0 100 1 10 10 + + + 0 + False + False + + + + + + True + with + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + True + + + + + + True + True + 1 + 0 + False + GTK_UPDATE_ALWAYS + False + False + 1 0 100 1 10 10 + + + 0 + False + False + + + + + + + + True + <b>Swap</b> + False + True + GTK_JUSTIFY_LEFT + False + False + 0.5 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + label_item + + + + + 0 + False + False + + + + + + True + True + False + 0 + + + + + + + + True + <b>Reorder</b> + False + True + GTK_JUSTIFY_LEFT + False + False + 0.5 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + label_item + + + + + 0 + False + False + + + + + 0 + False + False + + + + + 0 + False + True + + + + + + + diff --git a/demo/treelist/ListTest.hs b/demo/treelist/ListTest.hs new file mode 100644 --- /dev/null +++ b/demo/treelist/ListTest.hs @@ -0,0 +1,102 @@ +module Main where + +import Graphics.UI.Gtk +import Graphics.UI.Gtk.Glade +import Graphics.UI.Gtk.ModelView as New + +data Phone = Phone { name :: String, number :: Int, marked :: Bool } + +main = do + initGUI + Just xml <- xmlNew "ListTest.glade" + + win <- xmlGetWidget xml castToWindow "window" + onDestroy win mainQuit + + view <- xmlGetWidget xml castToTreeView "view" + + stringValue <- xmlGetWidget xml castToEntry "stringValue" + intValue <- xmlGetWidget xml castToSpinButton "intValue" + boolValue <- xmlGetWidget xml castToCheckButton "boolValue" + + insertButton <- xmlGetWidget xml castToButton "insert" + prependButton <- xmlGetWidget xml castToButton "prepend" + appendButton <- xmlGetWidget xml castToButton "append" + updateButton <- xmlGetWidget xml castToButton "update" + newIndex <- xmlGetWidget xml castToSpinButton "newIndex" + updateIndex <- xmlGetWidget xml castToSpinButton "updateIndex" + + removeButton <- xmlGetWidget xml castToButton "remove" + clearButton <- xmlGetWidget xml castToButton "clear" + removeIndex <- xmlGetWidget xml castToSpinButton "removeIndex" + + -- create a new list store + store <- storeImpl + New.treeViewSetModel view store + setupView view store + + let getValues = do + name <- entryGetText stringValue + number <- spinButtonGetValue intValue + marked <- toggleButtonGetActive boolValue + return Phone { + name = name, + number = floor number, + marked = marked + } + + onClicked prependButton $ getValues >>= New.listStorePrepend store + onClicked appendButton $ getValues >>= New.listStoreAppend store >> return () + + onClicked insertButton $ do + value <- getValues + index <- fmap floor $ spinButtonGetValue newIndex + New.listStoreInsert store index value + + onClicked updateButton $ do + value <- getValues + index <- fmap floor $ spinButtonGetValue updateIndex + New.listStoreSetValue store index value + + onClicked removeButton $ do + index <- fmap floor $ spinButtonGetValue removeIndex + New.listStoreRemove store index + + onClicked clearButton $ New.listStoreClear store + + New.treeViewSetReorderable view True + +-- containerAdd win view + widgetShowAll win + mainGUI + +setupView view model = do + New.treeViewSetHeadersVisible view True + + -- add a couple columns + renderer1 <- New.cellRendererTextNew + col1 <- New.treeViewColumnNew + New.treeViewColumnPackStart col1 renderer1 True + New.cellLayoutSetAttributes col1 renderer1 model $ \row -> [ New.cellText := name row ] + New.treeViewColumnSetTitle col1 "String column" + New.treeViewAppendColumn view col1 + + renderer2 <- New.cellRendererTextNew + col2 <- New.treeViewColumnNew + New.treeViewColumnPackStart col2 renderer2 True + New.cellLayoutSetAttributes col2 renderer2 model $ \row -> [ New.cellText := show (number row) ] + New.treeViewColumnSetTitle col2 "Int column" + New.treeViewAppendColumn view col2 + + renderer3 <- New.cellRendererToggleNew + col3 <- New.treeViewColumnNew + New.treeViewColumnPackStart col3 renderer3 True + New.cellLayoutSetAttributes col3 renderer3 model $ \row -> [ New.cellToggleActive := marked row ] + New.treeViewColumnSetTitle col3 "Check box column" + New.treeViewAppendColumn view col3 + +storeImpl = + New.listStoreNew + [Phone { name = "Foo", number = 12345, marked = False } + ,Phone { name = "Bar", number = 67890, marked = True } + ,Phone { name = "Baz", number = 39496, marked = False }] diff --git a/demo/treelist/ListText.hs b/demo/treelist/ListText.hs new file mode 100644 --- /dev/null +++ b/demo/treelist/ListText.hs @@ -0,0 +1,77 @@ +import Graphics.UI.Gtk +import Data.Char +import Data.List +import Data.Maybe + +data RowInfo = RowInfo { rowString :: String, rowCase :: Maybe Bool } + +mkCase Nothing str = str +mkCase (Just False) str = map toLower str +mkCase (Just True) str = map toUpper str + +advCase Nothing = Just False +advCase (Just False) = Just True +advCase (Just True) = Nothing + +main :: IO () +main = do + unsafeInitGUIForThreadedRTS + win <- windowNew + win `on` objectDestroy $ mainQuit + + content <- readFile "ListText.hs" + + model <- listStoreNew (map (\r -> RowInfo r Nothing) (lines content)) + view <- treeViewNewWithModel model + + -- add a column showing the index + col <- treeViewColumnNew + treeViewAppendColumn view col + + cell <- cellRendererTextNew + cellLayoutPackStart col cell True + cellLayoutSetAttributeFunc col cell model $ \(TreeIter _ n _ _) -> + set cell [cellText := show n] + set col [treeViewColumnTitle := "line", + treeViewColumnReorderable := True ] + + -- add a column showing the line in the file + col <- treeViewColumnNew + treeViewAppendColumn view col + set col [treeViewColumnTitle := "line in file", + treeViewColumnReorderable := True ] + + cell <- cellRendererTextNew + cellLayoutPackStart col cell True + cellLayoutSetAttributes col cell model $ + \row -> [cellText := mkCase (rowCase row) (rowString row)] + + -- add a column showing if it is forced to a specific case + col <- treeViewColumnNew + treeViewAppendColumn view col + set col [treeViewColumnTitle := "case", + treeViewColumnReorderable := True ] + + cell <- cellRendererToggleNew + cellLayoutPackStart col cell True + cellLayoutSetAttributes col cell model $ + \row -> [cellToggleActive := fromMaybe False (rowCase row), + cellToggleInconsistent := rowCase row==Nothing] + cell `on` cellToggled $ \tpStr -> do + let [i] = stringToTreePath tpStr + row@RowInfo { rowCase = c } <- listStoreGetValue model i + listStoreSetValue model i row { rowCase = advCase c } + + -- to annoy the user: don't allow any columns to be dropped at the far right + treeViewSetColumnDragFunction view $ Just $ \_ rCol _ -> do + return (rCol /= Nothing) + + treeViewSetSearchEqualFunc view $ Just $ \str (TreeIter _ n _ _) -> do + row <- listStoreGetValue model (fromIntegral n) + return (map toLower str `isPrefixOf` map toLower (filter isAlphaNum (rowString row))) + + swin <- scrolledWindowNew Nothing Nothing + set swin [ containerChild := view ] + set win [ containerChild := swin ] + widgetShowAll win + mainGUI diff --git a/demo/treelist/Makefile b/demo/treelist/Makefile new file mode 100644 --- /dev/null +++ b/demo/treelist/Makefile @@ -0,0 +1,45 @@ + +PROGS = listdemo treedemo listtest treetest dirlist treesort completion \ + listdnd filterdemo listtext + +SOURCES = ListDemo.hs TreeDemo.hs ListTest.hs TreeTest.hs DirList.hs \ + TreeSort.hs Completion.hs ListDND.hs FilterDemo.hs ListText.hs + +all : $(PROGS) + +listdemo : ListDemo.hs + $(HC_RULE) + +treedemo : TreeDemo.hs + $(HC_RULE) + +listtest : ListTest.hs + $(HC_RULE) + +treetest : TreeTest.hs + $(HC_RULE) + +dirlist : DirList.hs + $(HC_RULE) + +treesort : TreeSort.hs + $(HC_RULE) + +completion : Completion.hs + $(HC_RULE) + +listdnd : ListDND.hs + $(HC_RULE) + +filterdemo : FilterDemo.hs + $(HC_RULE) + +listtext : ListText.hs + $(HC_RULE) + +HC_RULE = $(HC) --make $< -o $@ $(HCFLAGS) + +clean: + rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS) + +HC=ghc diff --git a/demo/treelist/TreeDemo.hs b/demo/treelist/TreeDemo.hs new file mode 100644 --- /dev/null +++ b/demo/treelist/TreeDemo.hs @@ -0,0 +1,68 @@ +module Main where + +import Graphics.UI.Gtk +import Graphics.UI.Gtk.ModelView as New + +import qualified Data.Tree as Tree + +data Phone = Phone { name :: String, number :: Int, marked :: Bool } + +main = do + initGUI + + win <- windowNew + onDestroy win mainQuit + + -- create a new tree model + model <- storeImpl + view <- New.treeViewNewWithModel model + + New.treeViewSetHeadersVisible view True + + -- add three columns + col1 <- New.treeViewColumnNew + col2 <- New.treeViewColumnNew + col3 <- New.treeViewColumnNew + + New.treeViewColumnSetTitle col1 "String column" + New.treeViewColumnSetTitle col2 "Int column" + New.treeViewColumnSetTitle col3 "Bool column" + + renderer1 <- New.cellRendererTextNew + renderer2 <- New.cellRendererTextNew + renderer3 <- New.cellRendererToggleNew + + New.cellLayoutPackStart col1 renderer1 True + New.cellLayoutPackStart col2 renderer2 True + New.cellLayoutPackStart col3 renderer3 True + + New.cellLayoutSetAttributes col1 renderer1 model $ \row -> [ New.cellText := name row ] + New.cellLayoutSetAttributes col2 renderer2 model $ \row -> [ New.cellText := show (number row) ] + New.cellLayoutSetAttributes col3 renderer3 model $ \row -> [ New.cellToggleActive := marked row ] + + New.treeViewAppendColumn view col1 + New.treeViewAppendColumn view col2 + New.treeViewAppendColumn view col3 + + containerAdd win view + widgetShowAll win + mainGUI + +storeImpl = + New.treeStoreNew + [Tree.Node { + Tree.rootLabel = Phone { name = "Foo", number = 1, marked = False }, + Tree.subForest = [leafNode Phone { name = "Bar", number = 11, marked = True } + ,leafNode Phone { name = "Baz", number = 12, marked = False }] + }, + Tree.Node { + Tree.rootLabel = Phone { name = "Foo", number = 2, marked = False }, + Tree.subForest = [leafNode Phone { name = "Bar", number = 21, marked = True } + ,leafNode Phone { name = "Baz", number = 22, marked = False }] + }, + Tree.Node { + Tree.rootLabel = Phone { name = "Foo", number = 3, marked = False }, + Tree.subForest = [leafNode Phone { name = "Bar", number = 31, marked = True } + ,leafNode Phone { name = "Baz", number = 32, marked = False }] + }] + where leafNode a = Tree.Node { Tree.rootLabel = a, Tree.subForest = [] } diff --git a/demo/treelist/TreeSort.hs b/demo/treelist/TreeSort.hs new file mode 100644 --- /dev/null +++ b/demo/treelist/TreeSort.hs @@ -0,0 +1,85 @@ +import Graphics.UI.Gtk +import Graphics.UI.Gtk.ModelView as New +import Data.Tree + +main = do + initGUI + win <- windowNew + -- Create a tree model with some unsorted data. + rawmodel <- New.treeStoreNew + [Node ("zoo",8) [], Node ("foo",5) [], + Node ("bar",20) [], Node ("baz",2) []] + + -- Create a sorting proxy model, that is, a model that permutates the + -- rows of a different model such that they appear to be sorted. + model <- New.treeModelSortNewWithModel rawmodel + + -- Define two sorting functions, one being the default sorting function and + -- the other one being the sorting function for the 'SortColumnId' 2. + -- 'SortColumnId's are arbitrary positive numbers, i.e., we could have chosen + -- any other unique number. + New.treeSortableSetDefaultSortFunc model $ Just $ \iter1 iter2 -> do + (t1,_) <- New.treeModelGetRow rawmodel iter1 + (t2,_) <- New.treeModelGetRow rawmodel iter2 + return (compare t1 t2) + New.treeSortableSetSortFunc model 2 $ \iter1 iter2 -> do + (_,n1) <- New.treeModelGetRow rawmodel iter1 + (_,n2) <- New.treeModelGetRow rawmodel iter2 + return (compare n1 n2) + + -- Create the view. + view <- New.treeViewNewWithModel model + + -- Create and insert two columns, one with the heading Name, one with the + -- heading Number. Associate the 'SortColumnId' 2 with the latter column such + -- that clicking on the Number header will sort the rows by the numbers. + col <- New.treeViewColumnNew + New.treeViewColumnSetTitle col "Name" + rend <- New.cellRendererTextNew + New.cellLayoutPackStart col rend True + New.cellLayoutSetAttributeFunc col rend model $ \iter -> do + cIter <- New.treeModelSortConvertIterToChildIter model iter + (n,_) <- New.treeModelGetRow rawmodel cIter + set rend [New.cellText := n] + New.treeViewAppendColumn view col + + col' <- New.treeViewColumnNew + New.treeViewColumnSetTitle col' "Number" + rend <- New.cellRendererTextNew + New.cellLayoutPackStart col' rend True + New.cellLayoutSetAttributeFunc col' rend model $ \iter -> do + cIter <- New.treeModelSortConvertIterToChildIter model iter + (_,c) <- New.treeModelGetRow rawmodel cIter + set rend [New.cellText := show c] + New.treeViewAppendColumn view col' + New.treeViewColumnSetSortColumnId col' 2 + + -- Create a button that shows information on the current state of the sorting + -- settings. + button <- buttonNewWithLabel "Dump Info" + button `onClicked` do + sId <- New.treeViewColumnGetSortColumnId col + putStrLn ("tvc1 sort id is "++show sId) + sId <- New.treeViewColumnGetSortColumnId col' + putStrLn ("tvc2 sort id is "++show sId) + sId <- New.treeSortableGetSortColumnId model + putStrLn ("sort id is "++show sId) + -- Show all entries of the proxy model + let recurse Nothing = return () + recurse (Just iter) = do + cIter <- New.treeModelSortConvertIterToChildIter model iter + row <- New.treeModelGetRow rawmodel cIter + putStrLn ("iter "++show cIter++": "++show row) + mIter <- New.treeModelIterNext model iter + recurse mIter + mIter <- New.treeModelGetIterFirst model + recurse mIter + + -- Put it all together. + vBox <- vBoxNew False 3 + boxPackStartDefaults vBox view + boxPackEnd vBox button PackNatural 0 + containerAdd win vBox + widgetShowAll win + win `onDestroy` mainQuit + mainGUI diff --git a/demo/treelist/TreeTest.glade b/demo/treelist/TreeTest.glade new file mode 100644 --- /dev/null +++ b/demo/treelist/TreeTest.glade @@ -0,0 +1,1108 @@ + + + + + + + True + Tree Test + GTK_WINDOW_TOPLEVEL + GTK_WIN_POS_NONE + False + True + False + True + False + False + GDK_WINDOW_TYPE_HINT_NORMAL + GDK_GRAVITY_NORTH_WEST + True + False + + + + True + False + 0 + + + + True + True + GTK_POLICY_ALWAYS + GTK_POLICY_ALWAYS + GTK_SHADOW_IN + GTK_CORNER_TOP_LEFT + + + + True + True + True + False + False + True + False + False + False + + + + + 0 + True + True + + + + + + 8 + True + False + 12 + + + + True + True + True + 0 + + + + 2 + True + 3 + 2 + False + 4 + 18 + + + + True + True + 1 + 0 + True + GTK_UPDATE_ALWAYS + True + False + 1 0 100 1 10 10 + + + 1 + 2 + 1 + 2 + + + + + + + True + True + GTK_RELIEF_NORMAL + True + False + False + True + + + + + + + 1 + 2 + 2 + 3 + fill + + + + + + + True + True + True + True + 0 + + True + * + False + + + 1 + 2 + 0 + 1 + expand|shrink|fill + + + + + + + True + Number value: + False + False + GTK_JUSTIFY_LEFT + False + False + 1 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + 1 + 1 + 2 + + + + + + + + True + String value: + False + False + GTK_JUSTIFY_LEFT + False + False + 1 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + 1 + 0 + 1 + + + + + + + + True + Boolean value: + False + False + GTK_JUSTIFY_LEFT + False + False + 1 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + 1 + 2 + 3 + + + + + + + + + + True + <b>Value</b> + False + True + GTK_JUSTIFY_LEFT + False + False + 0.5 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + label_item + + + + + 0 + False + False + + + + + + True + True + True + 0 + + + + True + 2 + 3 + False + 4 + 2 + + + + True + True + insert + True + GTK_RELIEF_NORMAL + True + + + 0 + 1 + 0 + 1 + fill + + + + + + + True + new entry at + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 1 + 2 + 0 + 1 + fill + + + + + + + True + True + True + True + 0 + + True + * + False + 10 + + + 2 + 3 + 0 + 1 + + + + + + + True + True + update + True + GTK_RELIEF_NORMAL + True + + + 0 + 1 + 1 + 2 + fill + + + + + + + True + entry at + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 1 + 2 + 1 + 2 + fill + + + + + + + True + True + True + True + 0 + + True + * + False + 10 + + + 2 + 3 + 1 + 2 + + + + + + + + + True + <b>Insert and Update</b> + False + True + GTK_JUSTIFY_LEFT + False + False + 0.5 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + label_item + + + + + 0 + False + False + + + + + + True + True + True + 0 + + + + True + 2 + 3 + False + 4 + 2 + + + + 54 + True + True + delete + True + GTK_RELIEF_NORMAL + True + + + 0 + 1 + 0 + 1 + fill + + + + + + + True + True + clear + True + GTK_RELIEF_NORMAL + True + + + 0 + 1 + 1 + 2 + fill + + + + + + + True + entry + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 1 + 2 + 0 + 1 + fill + + + + + + + True + all + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 1 + 2 + 1 + 2 + fill + + + + + + + True + True + True + True + 0 + + True + * + False + 10 + + + 2 + 3 + 0 + 1 + + + + + + + + + True + <b>Delete</b> + False + True + GTK_JUSTIFY_LEFT + False + False + 0.5 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + label_item + + + + + 0 + False + False + + + + + + True + True + False + 0 + + + + True + 2 + 5 + False + 4 + 2 + + + + 54 + True + True + move + True + GTK_RELIEF_NORMAL + True + + + 0 + 1 + 0 + 1 + fill + + + + + + + 54 + True + True + move + True + GTK_RELIEF_NORMAL + True + + + 0 + 1 + 1 + 2 + fill + + + + + + + True + entry + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 1 + 2 + 0 + 1 + fill + + + + + + + True + entry + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 1 + 2 + 1 + 2 + fill + + + + + + + True + before + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 3 + 4 + 0 + 1 + fill + + + + + + + True + after + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 3 + 4 + 1 + 2 + fill + + + + + + + True + True + True + True + 0 + + True + * + False + 10 + + + 2 + 3 + 0 + 1 + + + + + + + True + True + True + True + 0 + + True + * + False + 10 + + + 4 + 5 + 0 + 1 + + + + + + + True + True + True + True + 0 + + True + * + False + 10 + + + 2 + 3 + 1 + 2 + + + + + + + True + True + True + True + 0 + + True + * + False + 10 + + + 4 + 5 + 1 + 2 + + + + + + + + + True + <b>Move</b> + False + True + GTK_JUSTIFY_LEFT + False + False + 0.5 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + label_item + + + + + 0 + False + False + + + + + + True + True + False + 0 + + + + 4 + True + False + 2 + + + + 54 + True + True + swap + True + GTK_RELIEF_NORMAL + True + + + 0 + False + False + + + + + + True + entry + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + True + + + + + + True + True + True + True + 0 + + True + * + False + 10 + + + 0 + True + True + + + + + + True + with + False + False + GTK_JUSTIFY_LEFT + False + False + 0 + 0.5 + 4 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + 0 + False + True + + + + + + True + True + True + True + 0 + + True + * + False + 10 + + + 0 + True + True + + + + + + + + True + <b>Swap</b> + False + True + GTK_JUSTIFY_LEFT + False + False + 0.5 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + label_item + + + + + 0 + False + False + + + + + + True + True + False + 0 + + + + + + + + True + <b>Reorder</b> + False + True + GTK_JUSTIFY_LEFT + False + False + 0.5 + 0.5 + 0 + 0 + PANGO_ELLIPSIZE_NONE + -1 + False + 0 + + + label_item + + + + + 0 + False + False + + + + + 0 + False + True + + + + + + + diff --git a/demo/treelist/TreeTest.hs b/demo/treelist/TreeTest.hs new file mode 100644 --- /dev/null +++ b/demo/treelist/TreeTest.hs @@ -0,0 +1,115 @@ +module Main where + +import Graphics.UI.Gtk +import Graphics.UI.Gtk.Glade +import Graphics.UI.Gtk.ModelView as New + +import qualified Data.Tree as Tree + +data Phone = Phone { name :: String, number :: Int, marked :: Bool } + +main = do + initGUI + Just xml <- xmlNew "TreeTest.glade" + + win <- xmlGetWidget xml castToWindow "window" + onDestroy win mainQuit + + view <- xmlGetWidget xml castToTreeView "view" + + stringValue <- xmlGetWidget xml castToEntry "stringValue" + intValue <- xmlGetWidget xml castToSpinButton "intValue" + boolValue <- xmlGetWidget xml castToCheckButton "boolValue" + + insertButton <- xmlGetWidget xml castToButton "insert" + updateButton <- xmlGetWidget xml castToButton "update" + newPath <- xmlGetWidget xml castToEntry "newPath" + updatePath <- xmlGetWidget xml castToEntry "updatePath" + + removeButton <- xmlGetWidget xml castToButton "remove" + clearButton <- xmlGetWidget xml castToButton "clear" + removePath <- xmlGetWidget xml castToEntry "removePath" + + -- create a new list store + store <- storeImpl + New.treeViewSetModel view store + setupView view store + + let getValues = do + name <- entryGetText stringValue + number <- spinButtonGetValue intValue + marked <- toggleButtonGetActive boolValue + return Phone { + name = name, + number = floor number, + marked = marked + } + + onClicked insertButton $ do + value <- getValues + path <- fmap read $ get newPath entryText + New.treeStoreInsert store (init path) (last path) value + + onClicked updateButton $ do + value <- getValues + path <- fmap read $ get updatePath entryText + New.treeStoreSetValue store path value + + onClicked removeButton $ do + path <- fmap read $ get removePath entryText + New.treeStoreRemove store path + return () + + onClicked clearButton $ New.treeStoreClear store + + New.treeViewSetReorderable view True + + widgetShowAll win + mainGUI + +setupView view model = do + New.treeViewSetHeadersVisible view True + + -- add three columns + col1 <- New.treeViewColumnNew + col2 <- New.treeViewColumnNew + col3 <- New.treeViewColumnNew + + New.treeViewColumnSetTitle col1 "String column" + New.treeViewColumnSetTitle col2 "Int column" + New.treeViewColumnSetTitle col3 "Bool column" + + renderer1 <- New.cellRendererTextNew + renderer2 <- New.cellRendererTextNew + renderer3 <- New.cellRendererToggleNew + + New.cellLayoutPackStart col1 renderer1 True + New.cellLayoutPackStart col2 renderer2 True + New.cellLayoutPackStart col3 renderer3 True + + New.cellLayoutSetAttributes col1 renderer1 model $ \row -> [ New.cellText := name row ] + New.cellLayoutSetAttributes col2 renderer2 model $ \row -> [ New.cellText := show (number row) ] + New.cellLayoutSetAttributes col3 renderer3 model $ \row -> [ New.cellToggleActive := marked row ] + + New.treeViewAppendColumn view col1 + New.treeViewAppendColumn view col2 + New.treeViewAppendColumn view col3 + +storeImpl = + New.treeStoreNew + [Tree.Node { + Tree.rootLabel = Phone { name = "Foo", number = 1, marked = False }, + Tree.subForest = [leafNode Phone { name = "Bar", number = 11, marked = True } + ,leafNode Phone { name = "Baz", number = 12, marked = False }] + }, + Tree.Node { + Tree.rootLabel = Phone { name = "Foo", number = 2, marked = False }, + Tree.subForest = [leafNode Phone { name = "Bar", number = 21, marked = True } + ,leafNode Phone { name = "Baz", number = 22, marked = False }] + }, + Tree.Node { + Tree.rootLabel = Phone { name = "Foo", number = 3, marked = False }, + Tree.subForest = [leafNode Phone { name = "Bar", number = 31, marked = True } + ,leafNode Phone { name = "Baz", number = 32, marked = False }] + }] + where leafNode a = Tree.Node { Tree.rootLabel = a, Tree.subForest = [] } diff --git a/demo/treelist/resListDND/desktop.png b/demo/treelist/resListDND/desktop.png new file mode 100644 Binary files /dev/null and b/demo/treelist/resListDND/desktop.png differ diff --git a/demo/treelist/resListDND/laptop.png b/demo/treelist/resListDND/laptop.png new file mode 100644 Binary files /dev/null and b/demo/treelist/resListDND/laptop.png differ diff --git a/demo/treelist/resListDND/laptopSmall.png b/demo/treelist/resListDND/laptopSmall.png new file mode 100644 Binary files /dev/null and b/demo/treelist/resListDND/laptopSmall.png differ diff --git a/demo/treelist/resListDND/printer.png b/demo/treelist/resListDND/printer.png new file mode 100644 Binary files /dev/null and b/demo/treelist/resListDND/printer.png differ diff --git a/demo/treelist/resListDND/server.png b/demo/treelist/resListDND/server.png new file mode 100644 Binary files /dev/null and b/demo/treelist/resListDND/server.png differ diff --git a/demo/treelist/resListDND/tower.png b/demo/treelist/resListDND/tower.png new file mode 100644 Binary files /dev/null and b/demo/treelist/resListDND/tower.png differ diff --git a/demo/treelist/rgb.txt b/demo/treelist/rgb.txt new file mode 100644 --- /dev/null +++ b/demo/treelist/rgb.txt @@ -0,0 +1,753 @@ +! $Xorg: rgb.txt,v 1.3 2000/08/17 19:54:00 cpqbld Exp $ +255 250 250 snow +248 248 255 ghost white +248 248 255 GhostWhite +245 245 245 white smoke +245 245 245 WhiteSmoke +220 220 220 gainsboro +255 250 240 floral white +255 250 240 FloralWhite +253 245 230 old lace +253 245 230 OldLace +250 240 230 linen +250 235 215 antique white +250 235 215 AntiqueWhite +255 239 213 papaya whip +255 239 213 PapayaWhip +255 235 205 blanched almond +255 235 205 BlanchedAlmond +255 228 196 bisque +255 218 185 peach puff +255 218 185 PeachPuff +255 222 173 navajo white +255 222 173 NavajoWhite +255 228 181 moccasin +255 248 220 cornsilk +255 255 240 ivory +255 250 205 lemon chiffon +255 250 205 LemonChiffon +255 245 238 seashell +240 255 240 honeydew +245 255 250 mint cream +245 255 250 MintCream +240 255 255 azure +240 248 255 alice blue +240 248 255 AliceBlue +230 230 250 lavender +255 240 245 lavender blush +255 240 245 LavenderBlush +255 228 225 misty rose +255 228 225 MistyRose +255 255 255 white + 0 0 0 black + 47 79 79 dark slate gray + 47 79 79 DarkSlateGray + 47 79 79 dark slate grey + 47 79 79 DarkSlateGrey +105 105 105 dim gray +105 105 105 DimGray +105 105 105 dim grey +105 105 105 DimGrey +112 128 144 slate gray +112 128 144 SlateGray +112 128 144 slate grey +112 128 144 SlateGrey +119 136 153 light slate gray +119 136 153 LightSlateGray +119 136 153 light slate grey +119 136 153 LightSlateGrey +190 190 190 gray +190 190 190 grey +211 211 211 light grey +211 211 211 LightGrey +211 211 211 light gray +211 211 211 LightGray + 25 25 112 midnight blue + 25 25 112 MidnightBlue + 0 0 128 navy + 0 0 128 navy blue + 0 0 128 NavyBlue +100 149 237 cornflower blue +100 149 237 CornflowerBlue + 72 61 139 dark slate blue + 72 61 139 DarkSlateBlue +106 90 205 slate blue +106 90 205 SlateBlue +123 104 238 medium slate blue +123 104 238 MediumSlateBlue +132 112 255 light slate blue +132 112 255 LightSlateBlue + 0 0 205 medium blue + 0 0 205 MediumBlue + 65 105 225 royal blue + 65 105 225 RoyalBlue + 0 0 255 blue + 30 144 255 dodger blue + 30 144 255 DodgerBlue + 0 191 255 deep sky blue + 0 191 255 DeepSkyBlue +135 206 235 sky blue +135 206 235 SkyBlue +135 206 250 light sky blue +135 206 250 LightSkyBlue + 70 130 180 steel blue + 70 130 180 SteelBlue +176 196 222 light steel blue +176 196 222 LightSteelBlue +173 216 230 light blue +173 216 230 LightBlue +176 224 230 powder blue +176 224 230 PowderBlue +175 238 238 pale turquoise +175 238 238 PaleTurquoise + 0 206 209 dark turquoise + 0 206 209 DarkTurquoise + 72 209 204 medium turquoise + 72 209 204 MediumTurquoise + 64 224 208 turquoise + 0 255 255 cyan +224 255 255 light cyan +224 255 255 LightCyan + 95 158 160 cadet blue + 95 158 160 CadetBlue +102 205 170 medium aquamarine +102 205 170 MediumAquamarine +127 255 212 aquamarine + 0 100 0 dark green + 0 100 0 DarkGreen + 85 107 47 dark olive green + 85 107 47 DarkOliveGreen +143 188 143 dark sea green +143 188 143 DarkSeaGreen + 46 139 87 sea green + 46 139 87 SeaGreen + 60 179 113 medium sea green + 60 179 113 MediumSeaGreen + 32 178 170 light sea green + 32 178 170 LightSeaGreen +152 251 152 pale green +152 251 152 PaleGreen + 0 255 127 spring green + 0 255 127 SpringGreen +124 252 0 lawn green +124 252 0 LawnGreen + 0 255 0 green +127 255 0 chartreuse + 0 250 154 medium spring green + 0 250 154 MediumSpringGreen +173 255 47 green yellow +173 255 47 GreenYellow + 50 205 50 lime green + 50 205 50 LimeGreen +154 205 50 yellow green +154 205 50 YellowGreen + 34 139 34 forest green + 34 139 34 ForestGreen +107 142 35 olive drab +107 142 35 OliveDrab +189 183 107 dark khaki +189 183 107 DarkKhaki +240 230 140 khaki +238 232 170 pale goldenrod +238 232 170 PaleGoldenrod +250 250 210 light goldenrod yellow +250 250 210 LightGoldenrodYellow +255 255 224 light yellow +255 255 224 LightYellow +255 255 0 yellow +255 215 0 gold +238 221 130 light goldenrod +238 221 130 LightGoldenrod +218 165 32 goldenrod +184 134 11 dark goldenrod +184 134 11 DarkGoldenrod +188 143 143 rosy brown +188 143 143 RosyBrown +205 92 92 indian red +205 92 92 IndianRed +139 69 19 saddle brown +139 69 19 SaddleBrown +160 82 45 sienna +205 133 63 peru +222 184 135 burlywood +245 245 220 beige +245 222 179 wheat +244 164 96 sandy brown +244 164 96 SandyBrown +210 180 140 tan +210 105 30 chocolate +178 34 34 firebrick +165 42 42 brown +233 150 122 dark salmon +233 150 122 DarkSalmon +250 128 114 salmon +255 160 122 light salmon +255 160 122 LightSalmon +255 165 0 orange +255 140 0 dark orange +255 140 0 DarkOrange +255 127 80 coral +240 128 128 light coral +240 128 128 LightCoral +255 99 71 tomato +255 69 0 orange red +255 69 0 OrangeRed +255 0 0 red +255 105 180 hot pink +255 105 180 HotPink +255 20 147 deep pink +255 20 147 DeepPink +255 192 203 pink +255 182 193 light pink +255 182 193 LightPink +219 112 147 pale violet red +219 112 147 PaleVioletRed +176 48 96 maroon +199 21 133 medium violet red +199 21 133 MediumVioletRed +208 32 144 violet red +208 32 144 VioletRed +255 0 255 magenta +238 130 238 violet +221 160 221 plum +218 112 214 orchid +186 85 211 medium orchid +186 85 211 MediumOrchid +153 50 204 dark orchid +153 50 204 DarkOrchid +148 0 211 dark violet +148 0 211 DarkViolet +138 43 226 blue violet +138 43 226 BlueViolet +160 32 240 purple +147 112 219 medium purple +147 112 219 MediumPurple +216 191 216 thistle +255 250 250 snow1 +238 233 233 snow2 +205 201 201 snow3 +139 137 137 snow4 +255 245 238 seashell1 +238 229 222 seashell2 +205 197 191 seashell3 +139 134 130 seashell4 +255 239 219 AntiqueWhite1 +238 223 204 AntiqueWhite2 +205 192 176 AntiqueWhite3 +139 131 120 AntiqueWhite4 +255 228 196 bisque1 +238 213 183 bisque2 +205 183 158 bisque3 +139 125 107 bisque4 +255 218 185 PeachPuff1 +238 203 173 PeachPuff2 +205 175 149 PeachPuff3 +139 119 101 PeachPuff4 +255 222 173 NavajoWhite1 +238 207 161 NavajoWhite2 +205 179 139 NavajoWhite3 +139 121 94 NavajoWhite4 +255 250 205 LemonChiffon1 +238 233 191 LemonChiffon2 +205 201 165 LemonChiffon3 +139 137 112 LemonChiffon4 +255 248 220 cornsilk1 +238 232 205 cornsilk2 +205 200 177 cornsilk3 +139 136 120 cornsilk4 +255 255 240 ivory1 +238 238 224 ivory2 +205 205 193 ivory3 +139 139 131 ivory4 +240 255 240 honeydew1 +224 238 224 honeydew2 +193 205 193 honeydew3 +131 139 131 honeydew4 +255 240 245 LavenderBlush1 +238 224 229 LavenderBlush2 +205 193 197 LavenderBlush3 +139 131 134 LavenderBlush4 +255 228 225 MistyRose1 +238 213 210 MistyRose2 +205 183 181 MistyRose3 +139 125 123 MistyRose4 +240 255 255 azure1 +224 238 238 azure2 +193 205 205 azure3 +131 139 139 azure4 +131 111 255 SlateBlue1 +122 103 238 SlateBlue2 +105 89 205 SlateBlue3 + 71 60 139 SlateBlue4 + 72 118 255 RoyalBlue1 + 67 110 238 RoyalBlue2 + 58 95 205 RoyalBlue3 + 39 64 139 RoyalBlue4 + 0 0 255 blue1 + 0 0 238 blue2 + 0 0 205 blue3 + 0 0 139 blue4 + 30 144 255 DodgerBlue1 + 28 134 238 DodgerBlue2 + 24 116 205 DodgerBlue3 + 16 78 139 DodgerBlue4 + 99 184 255 SteelBlue1 + 92 172 238 SteelBlue2 + 79 148 205 SteelBlue3 + 54 100 139 SteelBlue4 + 0 191 255 DeepSkyBlue1 + 0 178 238 DeepSkyBlue2 + 0 154 205 DeepSkyBlue3 + 0 104 139 DeepSkyBlue4 +135 206 255 SkyBlue1 +126 192 238 SkyBlue2 +108 166 205 SkyBlue3 + 74 112 139 SkyBlue4 +176 226 255 LightSkyBlue1 +164 211 238 LightSkyBlue2 +141 182 205 LightSkyBlue3 + 96 123 139 LightSkyBlue4 +198 226 255 SlateGray1 +185 211 238 SlateGray2 +159 182 205 SlateGray3 +108 123 139 SlateGray4 +202 225 255 LightSteelBlue1 +188 210 238 LightSteelBlue2 +162 181 205 LightSteelBlue3 +110 123 139 LightSteelBlue4 +191 239 255 LightBlue1 +178 223 238 LightBlue2 +154 192 205 LightBlue3 +104 131 139 LightBlue4 +224 255 255 LightCyan1 +209 238 238 LightCyan2 +180 205 205 LightCyan3 +122 139 139 LightCyan4 +187 255 255 PaleTurquoise1 +174 238 238 PaleTurquoise2 +150 205 205 PaleTurquoise3 +102 139 139 PaleTurquoise4 +152 245 255 CadetBlue1 +142 229 238 CadetBlue2 +122 197 205 CadetBlue3 + 83 134 139 CadetBlue4 + 0 245 255 turquoise1 + 0 229 238 turquoise2 + 0 197 205 turquoise3 + 0 134 139 turquoise4 + 0 255 255 cyan1 + 0 238 238 cyan2 + 0 205 205 cyan3 + 0 139 139 cyan4 +151 255 255 DarkSlateGray1 +141 238 238 DarkSlateGray2 +121 205 205 DarkSlateGray3 + 82 139 139 DarkSlateGray4 +127 255 212 aquamarine1 +118 238 198 aquamarine2 +102 205 170 aquamarine3 + 69 139 116 aquamarine4 +193 255 193 DarkSeaGreen1 +180 238 180 DarkSeaGreen2 +155 205 155 DarkSeaGreen3 +105 139 105 DarkSeaGreen4 + 84 255 159 SeaGreen1 + 78 238 148 SeaGreen2 + 67 205 128 SeaGreen3 + 46 139 87 SeaGreen4 +154 255 154 PaleGreen1 +144 238 144 PaleGreen2 +124 205 124 PaleGreen3 + 84 139 84 PaleGreen4 + 0 255 127 SpringGreen1 + 0 238 118 SpringGreen2 + 0 205 102 SpringGreen3 + 0 139 69 SpringGreen4 + 0 255 0 green1 + 0 238 0 green2 + 0 205 0 green3 + 0 139 0 green4 +127 255 0 chartreuse1 +118 238 0 chartreuse2 +102 205 0 chartreuse3 + 69 139 0 chartreuse4 +192 255 62 OliveDrab1 +179 238 58 OliveDrab2 +154 205 50 OliveDrab3 +105 139 34 OliveDrab4 +202 255 112 DarkOliveGreen1 +188 238 104 DarkOliveGreen2 +162 205 90 DarkOliveGreen3 +110 139 61 DarkOliveGreen4 +255 246 143 khaki1 +238 230 133 khaki2 +205 198 115 khaki3 +139 134 78 khaki4 +255 236 139 LightGoldenrod1 +238 220 130 LightGoldenrod2 +205 190 112 LightGoldenrod3 +139 129 76 LightGoldenrod4 +255 255 224 LightYellow1 +238 238 209 LightYellow2 +205 205 180 LightYellow3 +139 139 122 LightYellow4 +255 255 0 yellow1 +238 238 0 yellow2 +205 205 0 yellow3 +139 139 0 yellow4 +255 215 0 gold1 +238 201 0 gold2 +205 173 0 gold3 +139 117 0 gold4 +255 193 37 goldenrod1 +238 180 34 goldenrod2 +205 155 29 goldenrod3 +139 105 20 goldenrod4 +255 185 15 DarkGoldenrod1 +238 173 14 DarkGoldenrod2 +205 149 12 DarkGoldenrod3 +139 101 8 DarkGoldenrod4 +255 193 193 RosyBrown1 +238 180 180 RosyBrown2 +205 155 155 RosyBrown3 +139 105 105 RosyBrown4 +255 106 106 IndianRed1 +238 99 99 IndianRed2 +205 85 85 IndianRed3 +139 58 58 IndianRed4 +255 130 71 sienna1 +238 121 66 sienna2 +205 104 57 sienna3 +139 71 38 sienna4 +255 211 155 burlywood1 +238 197 145 burlywood2 +205 170 125 burlywood3 +139 115 85 burlywood4 +255 231 186 wheat1 +238 216 174 wheat2 +205 186 150 wheat3 +139 126 102 wheat4 +255 165 79 tan1 +238 154 73 tan2 +205 133 63 tan3 +139 90 43 tan4 +255 127 36 chocolate1 +238 118 33 chocolate2 +205 102 29 chocolate3 +139 69 19 chocolate4 +255 48 48 firebrick1 +238 44 44 firebrick2 +205 38 38 firebrick3 +139 26 26 firebrick4 +255 64 64 brown1 +238 59 59 brown2 +205 51 51 brown3 +139 35 35 brown4 +255 140 105 salmon1 +238 130 98 salmon2 +205 112 84 salmon3 +139 76 57 salmon4 +255 160 122 LightSalmon1 +238 149 114 LightSalmon2 +205 129 98 LightSalmon3 +139 87 66 LightSalmon4 +255 165 0 orange1 +238 154 0 orange2 +205 133 0 orange3 +139 90 0 orange4 +255 127 0 DarkOrange1 +238 118 0 DarkOrange2 +205 102 0 DarkOrange3 +139 69 0 DarkOrange4 +255 114 86 coral1 +238 106 80 coral2 +205 91 69 coral3 +139 62 47 coral4 +255 99 71 tomato1 +238 92 66 tomato2 +205 79 57 tomato3 +139 54 38 tomato4 +255 69 0 OrangeRed1 +238 64 0 OrangeRed2 +205 55 0 OrangeRed3 +139 37 0 OrangeRed4 +255 0 0 red1 +238 0 0 red2 +205 0 0 red3 +139 0 0 red4 +255 20 147 DeepPink1 +238 18 137 DeepPink2 +205 16 118 DeepPink3 +139 10 80 DeepPink4 +255 110 180 HotPink1 +238 106 167 HotPink2 +205 96 144 HotPink3 +139 58 98 HotPink4 +255 181 197 pink1 +238 169 184 pink2 +205 145 158 pink3 +139 99 108 pink4 +255 174 185 LightPink1 +238 162 173 LightPink2 +205 140 149 LightPink3 +139 95 101 LightPink4 +255 130 171 PaleVioletRed1 +238 121 159 PaleVioletRed2 +205 104 137 PaleVioletRed3 +139 71 93 PaleVioletRed4 +255 52 179 maroon1 +238 48 167 maroon2 +205 41 144 maroon3 +139 28 98 maroon4 +255 62 150 VioletRed1 +238 58 140 VioletRed2 +205 50 120 VioletRed3 +139 34 82 VioletRed4 +255 0 255 magenta1 +238 0 238 magenta2 +205 0 205 magenta3 +139 0 139 magenta4 +255 131 250 orchid1 +238 122 233 orchid2 +205 105 201 orchid3 +139 71 137 orchid4 +255 187 255 plum1 +238 174 238 plum2 +205 150 205 plum3 +139 102 139 plum4 +224 102 255 MediumOrchid1 +209 95 238 MediumOrchid2 +180 82 205 MediumOrchid3 +122 55 139 MediumOrchid4 +191 62 255 DarkOrchid1 +178 58 238 DarkOrchid2 +154 50 205 DarkOrchid3 +104 34 139 DarkOrchid4 +155 48 255 purple1 +145 44 238 purple2 +125 38 205 purple3 + 85 26 139 purple4 +171 130 255 MediumPurple1 +159 121 238 MediumPurple2 +137 104 205 MediumPurple3 + 93 71 139 MediumPurple4 +255 225 255 thistle1 +238 210 238 thistle2 +205 181 205 thistle3 +139 123 139 thistle4 + 0 0 0 gray0 + 0 0 0 grey0 + 3 3 3 gray1 + 3 3 3 grey1 + 5 5 5 gray2 + 5 5 5 grey2 + 8 8 8 gray3 + 8 8 8 grey3 + 10 10 10 gray4 + 10 10 10 grey4 + 13 13 13 gray5 + 13 13 13 grey5 + 15 15 15 gray6 + 15 15 15 grey6 + 18 18 18 gray7 + 18 18 18 grey7 + 20 20 20 gray8 + 20 20 20 grey8 + 23 23 23 gray9 + 23 23 23 grey9 + 26 26 26 gray10 + 26 26 26 grey10 + 28 28 28 gray11 + 28 28 28 grey11 + 31 31 31 gray12 + 31 31 31 grey12 + 33 33 33 gray13 + 33 33 33 grey13 + 36 36 36 gray14 + 36 36 36 grey14 + 38 38 38 gray15 + 38 38 38 grey15 + 41 41 41 gray16 + 41 41 41 grey16 + 43 43 43 gray17 + 43 43 43 grey17 + 46 46 46 gray18 + 46 46 46 grey18 + 48 48 48 gray19 + 48 48 48 grey19 + 51 51 51 gray20 + 51 51 51 grey20 + 54 54 54 gray21 + 54 54 54 grey21 + 56 56 56 gray22 + 56 56 56 grey22 + 59 59 59 gray23 + 59 59 59 grey23 + 61 61 61 gray24 + 61 61 61 grey24 + 64 64 64 gray25 + 64 64 64 grey25 + 66 66 66 gray26 + 66 66 66 grey26 + 69 69 69 gray27 + 69 69 69 grey27 + 71 71 71 gray28 + 71 71 71 grey28 + 74 74 74 gray29 + 74 74 74 grey29 + 77 77 77 gray30 + 77 77 77 grey30 + 79 79 79 gray31 + 79 79 79 grey31 + 82 82 82 gray32 + 82 82 82 grey32 + 84 84 84 gray33 + 84 84 84 grey33 + 87 87 87 gray34 + 87 87 87 grey34 + 89 89 89 gray35 + 89 89 89 grey35 + 92 92 92 gray36 + 92 92 92 grey36 + 94 94 94 gray37 + 94 94 94 grey37 + 97 97 97 gray38 + 97 97 97 grey38 + 99 99 99 gray39 + 99 99 99 grey39 +102 102 102 gray40 +102 102 102 grey40 +105 105 105 gray41 +105 105 105 grey41 +107 107 107 gray42 +107 107 107 grey42 +110 110 110 gray43 +110 110 110 grey43 +112 112 112 gray44 +112 112 112 grey44 +115 115 115 gray45 +115 115 115 grey45 +117 117 117 gray46 +117 117 117 grey46 +120 120 120 gray47 +120 120 120 grey47 +122 122 122 gray48 +122 122 122 grey48 +125 125 125 gray49 +125 125 125 grey49 +127 127 127 gray50 +127 127 127 grey50 +130 130 130 gray51 +130 130 130 grey51 +133 133 133 gray52 +133 133 133 grey52 +135 135 135 gray53 +135 135 135 grey53 +138 138 138 gray54 +138 138 138 grey54 +140 140 140 gray55 +140 140 140 grey55 +143 143 143 gray56 +143 143 143 grey56 +145 145 145 gray57 +145 145 145 grey57 +148 148 148 gray58 +148 148 148 grey58 +150 150 150 gray59 +150 150 150 grey59 +153 153 153 gray60 +153 153 153 grey60 +156 156 156 gray61 +156 156 156 grey61 +158 158 158 gray62 +158 158 158 grey62 +161 161 161 gray63 +161 161 161 grey63 +163 163 163 gray64 +163 163 163 grey64 +166 166 166 gray65 +166 166 166 grey65 +168 168 168 gray66 +168 168 168 grey66 +171 171 171 gray67 +171 171 171 grey67 +173 173 173 gray68 +173 173 173 grey68 +176 176 176 gray69 +176 176 176 grey69 +179 179 179 gray70 +179 179 179 grey70 +181 181 181 gray71 +181 181 181 grey71 +184 184 184 gray72 +184 184 184 grey72 +186 186 186 gray73 +186 186 186 grey73 +189 189 189 gray74 +189 189 189 grey74 +191 191 191 gray75 +191 191 191 grey75 +194 194 194 gray76 +194 194 194 grey76 +196 196 196 gray77 +196 196 196 grey77 +199 199 199 gray78 +199 199 199 grey78 +201 201 201 gray79 +201 201 201 grey79 +204 204 204 gray80 +204 204 204 grey80 +207 207 207 gray81 +207 207 207 grey81 +209 209 209 gray82 +209 209 209 grey82 +212 212 212 gray83 +212 212 212 grey83 +214 214 214 gray84 +214 214 214 grey84 +217 217 217 gray85 +217 217 217 grey85 +219 219 219 gray86 +219 219 219 grey86 +222 222 222 gray87 +222 222 222 grey87 +224 224 224 gray88 +224 224 224 grey88 +227 227 227 gray89 +227 227 227 grey89 +229 229 229 gray90 +229 229 229 grey90 +232 232 232 gray91 +232 232 232 grey91 +235 235 235 gray92 +235 235 235 grey92 +237 237 237 gray93 +237 237 237 grey93 +240 240 240 gray94 +240 240 240 grey94 +242 242 242 gray95 +242 242 242 grey95 +245 245 245 gray96 +245 245 245 grey96 +247 247 247 gray97 +247 247 247 grey97 +250 250 250 gray98 +250 250 250 grey98 +252 252 252 gray99 +252 252 252 grey99 +255 255 255 gray100 +255 255 255 grey100 +169 169 169 dark grey +169 169 169 DarkGrey +169 169 169 dark gray +169 169 169 DarkGray +0 0 139 dark blue +0 0 139 DarkBlue +0 139 139 dark cyan +0 139 139 DarkCyan +139 0 139 dark magenta +139 0 139 DarkMagenta +139 0 0 dark red +139 0 0 DarkRed +144 238 144 light green +144 238 144 LightGreen diff --git a/demo/unicode/Arabic.hs b/demo/unicode/Arabic.hs --- a/demo/unicode/Arabic.hs +++ b/demo/unicode/Arabic.hs @@ -11,7 +11,7 @@ dialogAddButton dia stockYes ResponseYes dialogAddButton dia stockNo ResponseNo contain <- dialogGetUpper dia - theText <- labelNew Nothing + theText <- labelNew Nothing labelSetMarkup theText arabic boxPackStartDefaults contain theText widgetShowAll dia @@ -26,7 +26,7 @@ -- Do you find Haskell a fantastic language? (language has a grammatical -- mistake in it) map chr [0x647,0x644,32,0x62A,0x62C,0x62F,0x646,32]++ - markSpan [FontForeground "red"] + markSpan [FontForeground "red"] (map chr [0x647,0x622,0x633,0x643,0x622,0x644])++ map chr [32,0x644,0x63A,0x62A,32,0x645,0x62F,0x647,0x634,0x62A,0x61F] diff --git a/gtk.cabal b/gtk.cabal --- a/gtk.cabal +++ b/gtk.cabal @@ -1,5 +1,5 @@ Name: gtk -Version: 0.11.2 +Version: 0.12.0 License: LGPL-2.1 License-file: COPYING Copyright: (c) 2001-2010 The Gtk2Hs Team @@ -22,16 +22,16 @@ template-hsc-gtk2hs.h Gtk2HsSetup.hs marshal.list - hierarchy.list - + hierarchy.list + x-Types-File: Graphics/UI/Gtk/Types.chs x-Types-ModName: Graphics.UI.Gtk.Types x-Types-Forward: *System.Glib.GObject Graphics.UI.Gtk.General.Threading x-Types-Destructor: objectUnrefFromMainloop x-Types-Hierarchy: hierarchy.list -Data-Dir: demo -Data-Files: actionMenu/ActionMenu.hs +Data-Dir: demo +Data-Files: actionMenu/ActionMenu.hs actionMenu/Makefile buttonbox/ButtonBox.hs @@ -46,6 +46,7 @@ embedded/Embedded.hs embedded/Makefile + embedded/MPlayer.hs embedded/Notes.txt embedded/Uzbl.hs @@ -76,36 +77,39 @@ menu/Makefile menu/MenuDemo.hs + notebook/Notebook.hs + notebook/Makefile + statusicon/Makefile statusicon/StatusIcon.hs - treeList/Completion.hs - treeList/DirList.hs - treeList/FilterDemo.hs - treeList/ListDemo.hs - treeList/ListDND.hs - treeList/ListTest.glade - treeList/ListTest.hs - treeList/ListText.hs - treeList/Makefile - treeList/rgb.txt - treeList/TreeDemo.hs - treeList/TreeSort.hs - treeList/TreeTest.glade - treeList/TreeTest.hs + treelist/Completion.hs + treelist/DirList.hs + treelist/FilterDemo.hs + treelist/ListDemo.hs + treelist/ListDND.hs + treelist/ListTest.glade + treelist/ListTest.hs + treelist/ListText.hs + treelist/Makefile + treelist/rgb.txt + treelist/TreeDemo.hs + treelist/TreeSort.hs + treelist/TreeTest.glade + treelist/TreeTest.hs - treeList/resListDND/desktop.png - treeList/resListDND/laptop.png - treeList/resListDND/laptopSmall.png - treeList/resListDND/printer.png - treeList/resListDND/server.png - treeList/resListDND/tower.png + treelist/resListDND/desktop.png + treelist/resListDND/laptop.png + treelist/resListDND/laptopSmall.png + treelist/resListDND/printer.png + treelist/resListDND/server.png + treelist/resListDND/tower.png unicode/Arabic.hs unicode/Makefile - - demos.txt - + + demos.txt + Source-Repository head type: darcs location: http://code.haskell.org/gtk2hs/ @@ -118,16 +122,16 @@ Flag have-gio Description: Depend on GIO package, thereby enabling certain features. - Default: True + Default: True Library build-depends: base >= 4 && < 5, array, containers, haskell98, mtl, bytestring, - glib >= 0.11.1 && < 0.12, - pango >= 0.11.1 && < 0.12, - cairo >= 0.11.1 && < 0.12 + glib >= 0.12.0 && < 0.13, + pango >= 0.12.0 && < 0.13, + cairo >= 0.12.0 && < 0.13 if flag(have-gio) - build-depends: gio >= 0.11.1 && < 0.12 + build-depends: gio >= 0.12.0 && < 0.13 cpp-options: -DHAVE_GIO build-tools: gtk2hsC2hs, gtk2hsHookGenerator, gtk2hsTypeGen @@ -151,6 +155,7 @@ Graphics.UI.Gtk.ActionMenuToolbar.Action Graphics.UI.Gtk.ActionMenuToolbar.ActionGroup Graphics.UI.Gtk.ActionMenuToolbar.RadioAction + Graphics.UI.Gtk.ActionMenuToolbar.RecentAction Graphics.UI.Gtk.ActionMenuToolbar.ToggleAction Graphics.UI.Gtk.ActionMenuToolbar.UIManager Graphics.UI.Gtk.Builder @@ -158,24 +163,33 @@ Graphics.UI.Gtk.Buttons.CheckButton Graphics.UI.Gtk.Buttons.RadioButton Graphics.UI.Gtk.Buttons.ToggleButton + Graphics.UI.Gtk.Buttons.LinkButton + Graphics.UI.Gtk.Buttons.ScaleButton + Graphics.UI.Gtk.Buttons.VolumeButton Graphics.UI.Gtk.Cairo Graphics.UI.Gtk.Display.AccelLabel Graphics.UI.Gtk.Display.Image Graphics.UI.Gtk.Display.Label Graphics.UI.Gtk.Display.ProgressBar + Graphics.UI.Gtk.Display.Spinner Graphics.UI.Gtk.Display.Statusbar Graphics.UI.Gtk.Display.StatusIcon + Graphics.UI.Gtk.Display.InfoBar Graphics.UI.Gtk.Embedding.Embedding Graphics.UI.Gtk.Embedding.Plug Graphics.UI.Gtk.Embedding.Socket Graphics.UI.Gtk.Entry.Editable Graphics.UI.Gtk.Entry.Entry + Graphics.UI.Gtk.Entry.EntryBuffer Graphics.UI.Gtk.Entry.EntryCompletion Graphics.UI.Gtk.Entry.HScale Graphics.UI.Gtk.Entry.SpinButton Graphics.UI.Gtk.Entry.VScale + Graphics.UI.Gtk.Gdk.AppLaunchContext Graphics.UI.Gtk.Gdk.Cursor + Graphics.UI.Gtk.Gdk.Keymap Graphics.UI.Gtk.Gdk.Display + Graphics.UI.Gtk.Gdk.DisplayManager Graphics.UI.Gtk.Gdk.Drawable Graphics.UI.Gtk.Gdk.DrawWindow Graphics.UI.Gtk.Gdk.EventM @@ -230,6 +244,9 @@ Graphics.UI.Gtk.MenuComboToolbar.Toolbar Graphics.UI.Gtk.MenuComboToolbar.ToolButton Graphics.UI.Gtk.MenuComboToolbar.ToolItem + Graphics.UI.Gtk.MenuComboToolbar.ToolItemGroup + Graphics.UI.Gtk.MenuComboToolbar.ToolPalette + Graphics.UI.Gtk.Misc.Accessible Graphics.UI.Gtk.Misc.Adjustment Graphics.UI.Gtk.Misc.Arrow Graphics.UI.Gtk.Misc.Calendar @@ -237,17 +254,22 @@ Graphics.UI.Gtk.Misc.EventBox Graphics.UI.Gtk.Misc.HandleBox Graphics.UI.Gtk.Misc.IMMulticontext + Graphics.UI.Gtk.Misc.IMContextSimple Graphics.UI.Gtk.Misc.SizeGroup Graphics.UI.Gtk.Misc.Tooltip Graphics.UI.Gtk.Misc.Tooltips Graphics.UI.Gtk.Misc.Viewport Graphics.UI.Gtk.ModelView + Graphics.UI.Gtk.ModelView.CellEditable Graphics.UI.Gtk.ModelView.CellLayout Graphics.UI.Gtk.ModelView.CellRenderer + Graphics.UI.Gtk.ModelView.CellRendererSpinner Graphics.UI.Gtk.ModelView.CellRendererCombo Graphics.UI.Gtk.ModelView.CellRendererPixbuf Graphics.UI.Gtk.ModelView.CellRendererProgress Graphics.UI.Gtk.ModelView.CellRendererText + Graphics.UI.Gtk.ModelView.CellRendererAccel + Graphics.UI.Gtk.ModelView.CellRendererSpin Graphics.UI.Gtk.ModelView.CellRendererToggle Graphics.UI.Gtk.ModelView.CellView Graphics.UI.Gtk.ModelView.CustomStore @@ -272,6 +294,17 @@ Graphics.UI.Gtk.Ornaments.Frame Graphics.UI.Gtk.Ornaments.HSeparator Graphics.UI.Gtk.Ornaments.VSeparator + Graphics.UI.Gtk.Printing.PaperSize + Graphics.UI.Gtk.Printing.PageSetup + Graphics.UI.Gtk.Printing.PrintContext + Graphics.UI.Gtk.Printing.PrintOperation + Graphics.UI.Gtk.Printing.PrintSettings + Graphics.UI.Gtk.Recent.RecentChooserMenu + Graphics.UI.Gtk.Recent.RecentChooserWidget + Graphics.UI.Gtk.Recent.RecentFilter + Graphics.UI.Gtk.Recent.RecentManager + Graphics.UI.Gtk.Recent.RecentInfo + Graphics.UI.Gtk.Recent.RecentChooser Graphics.UI.Gtk.Scrolling.HScrollbar Graphics.UI.Gtk.Scrolling.ScrolledWindow Graphics.UI.Gtk.Scrolling.VScrollbar @@ -287,11 +320,17 @@ Graphics.UI.Gtk.Selectors.FontButton Graphics.UI.Gtk.Selectors.FontSelection Graphics.UI.Gtk.Selectors.FontSelectionDialog + Graphics.UI.Gtk.Selectors.HSV + Graphics.UI.Gtk.Special.Ruler + Graphics.UI.Gtk.Special.HRuler + Graphics.UI.Gtk.Special.VRuler Graphics.UI.Gtk.Windows.AboutDialog + Graphics.UI.Gtk.Windows.Assistant Graphics.UI.Gtk.Windows.Dialog Graphics.UI.Gtk.Windows.Invisible Graphics.UI.Gtk.Windows.MessageDialog Graphics.UI.Gtk.Windows.Window + Graphics.UI.Gtk.Windows.OffscreenWindow Graphics.UI.Gtk.Windows.WindowGroup Graphics.UI.Gtk.General.Enums other-modules: @@ -310,7 +349,7 @@ extensions: ForeignFunctionInterface c-sources: Graphics/UI/Gtk/ModelView/Gtk2HsStore.c Graphics/UI/Gtk/General/hsgthread.c - -- Due to http://hackage.haskell.org/trac/ghc/ticket/781 + -- Due to http://hackage.haskell.org/trac/ghc/ticket/781 -- we need to compile the hsgthread.c module with -fPIC to ensure that a global -- variable in GLib that holds the address for the mutex lock and unlock functions -- is accessed correctly. This bug only exists on x86-64 platforms. diff --git a/hierarchy.list b/hierarchy.list --- a/hierarchy.list +++ b/hierarchy.list @@ -22,6 +22,18 @@ # if a different equality instance is manually # defined later GObject + AtkObject + GtkAccessible if gtk-2.22 + GdkKeymap if gtk-2.2 + GdkDisplayManager if gtk-2.2 + GdkAppLaunchContext if gtk-2.14 + GtkPrintSettings if gtk-2.10 + GtkPrintOperation if gtk-2.10 + GtkPrintOperationPreview if gtk-2.10 + GtkPageSetup if gtk-2.10 + GtkPrintContext if gtk-2.10 + GtkRecentChooser if gtk-2.10 + GtkRecentManager if gtk-2.10 GdkDrawable GdkWindow as DrawWindow, gdk_window_object_get_type # GdkDrawableImplX11 @@ -54,7 +66,9 @@ GtkSourceMarker if sourceview GtkSourceMark if gtksourceview2 GtkObject + GtkRecentFilter if gtk-2.10 GtkWidget + GtkHSV as HSV, gtk_hsv_get_type if gtk-2.14 GtkMisc GtkLabel GtkAccelLabel @@ -62,12 +76,17 @@ GtkArrow GtkImage GtkContainer + GtkToolPalette if gtk-2.20 + GtkToolItemGroup if gtk-2.20 WebKitWebView as WebView, webkit_web_view_get_type if webkit GtkBin GtkAlignment GtkFrame GtkAspectFrame GtkButton + GtkScaleButton if gtk-2.12 + GtkVolumeButton if gtk-2.12 + GtkLinkButton if gtk-2.10 GtkToggleButton GtkCheckButton GtkRadioButton @@ -84,6 +103,8 @@ GtkListItem if deprecated # GtkTreeItem GtkWindow + GtkAssistant if gtk-2.10 + GtkOffscreenWindow if gtk-2.20 GtkDialog GtkAboutDialog if gtk-2.6 GtkColorSelectionDialog @@ -113,10 +134,12 @@ GtkHButtonBox GtkVButtonBox GtkVBox + GtkRecentChooserWidget if gtk-2.10 GtkColorSelection GtkFontSelection GtkFileChooserWidget if gtk-2.4 GtkHBox + GtkInfoBar if gtk-2.18 GtkCombo if deprecated GtkFileChooserButton if gtk-2.6 GtkStatusbar @@ -131,6 +154,7 @@ GtkList if deprecated GtkMenuShell GtkMenu + GtkRecentChooserMenu if gtk-2.10 GtkMenuBar GtkNotebook # GtkPacker @@ -144,6 +168,7 @@ GtkCalendar GtkCellView if gtk-2.6 GtkDrawingArea + GtkSpinner if gtk-2.20 GtkEntry GtkSpinButton GtkRuler @@ -169,6 +194,7 @@ GtkAdjustment GtkIMContext GtkIMMulticontext + GtkIMContextSimple GtkItemFactory if deprecated GtkTooltips @@ -177,8 +203,11 @@ # These are derived from GtkObject: GtkTreeViewColumn GtkCellRenderer + GtkCellRendererSpinner if gtk-2.20 GtkCellRendererPixbuf GtkCellRendererText + GtkCellRendererAccel if gtk-2.10 + GtkCellRendererSpin if gtk-2.10 GtkCellRendererCombo if gtk-2.6 GtkCellRendererToggle GtkCellRendererProgress if gtk-2.6 @@ -204,7 +233,9 @@ GtkAccelGroup GtkAccelMap if gtk-2.4 GtkEntryCompletion if gtk-2.4 + GtkEntryBuffer if gtk-2.18 GtkAction if gtk-2.4 + GtkRecentAction if gtk-2.12 GtkToggleAction if gtk-2.4 GtkRadioAction if gtk-2.4 GtkActionGroup if gtk-2.4 @@ -217,6 +248,7 @@ GladeXML as GladeXML, glade_xml_get_type if libglade GConfClient as GConf if gconf # These ones are actualy interfaces, but interface implementations are GObjects + GtkCellEditable GtkEditable GtkSourceStyle as SourceStyleObject if gtksourceview2 GtkSourceStyleScheme if sourceview diff --git a/marshal.list b/marshal.list --- a/marshal.list +++ b/marshal.list @@ -155,3 +155,13 @@ NONE:BOXED,STRING # For queryTooltip BOOLEAN:TOBJECT,INT,INT,BOOLEAN,TOBJECT +# For EntryBuffer +NONE:INT,STRING,INT +# For CellRendererAccel +NONE:STRING,INT,ENUM,INT +# For PrintOperation +BOOLEAN:OBJECT +NONE:OBJECT,INT,OBJECT +NONE:OBJECT,OBJECT,OBJECT +BOOLEAN:OBJECT,OBJECT,OBJECT +VOID:ENUM,POINTER