Menu
▾
▴
gtk2hs-commit — Mailing list for Darcs commit messages.
You can subscribe to this list here.
| 2003 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(4) |
Jun
|
Jul
(68) |
Aug
(4) |
Sep
|
Oct
(23) |
Nov
(95) |
Dec
(9) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2004 |
Jan
(3) |
Feb
|
Mar
|
Apr
(51) |
May
(81) |
Jun
(2) |
Jul
(86) |
Aug
(143) |
Sep
(3) |
Oct
(31) |
Nov
(63) |
Dec
(90) |
| 2005 |
Jan
(277) |
Feb
(157) |
Mar
(99) |
Apr
(195) |
May
(151) |
Jun
(148) |
Jul
(98) |
Aug
(123) |
Sep
(20) |
Oct
(174) |
Nov
(155) |
Dec
(26) |
| 2006 |
Jan
(51) |
Feb
(19) |
Mar
(16) |
Apr
(12) |
May
(5) |
Jun
|
Jul
(11) |
Aug
(7) |
Sep
(10) |
Oct
(31) |
Nov
(174) |
Dec
(56) |
| 2007 |
Jan
(45) |
Feb
(52) |
Mar
(10) |
Apr
(5) |
May
(47) |
Jun
(16) |
Jul
(80) |
Aug
(29) |
Sep
(14) |
Oct
(59) |
Nov
(46) |
Dec
(16) |
| 2008 |
Jan
(10) |
Feb
(1) |
Mar
|
Apr
|
May
(49) |
Jun
(26) |
Jul
(8) |
Aug
(4) |
Sep
(25) |
Oct
(53) |
Nov
(9) |
Dec
(1) |
| 2009 |
Jan
(66) |
Feb
(11) |
Mar
(1) |
Apr
(14) |
May
(8) |
Jun
(1) |
Jul
(2) |
Aug
(2) |
Sep
(9) |
Oct
(23) |
Nov
(35) |
Dec
|
| 2010 |
Jan
(7) |
Feb
(2) |
Mar
(39) |
Apr
(19) |
May
(161) |
Jun
(19) |
Jul
(32) |
Aug
(65) |
Sep
(113) |
Oct
(120) |
Nov
(2) |
Dec
|
| 2012 |
Jan
|
Feb
(5) |
Mar
(4) |
Apr
(7) |
May
(9) |
Jun
(14) |
Jul
(1) |
Aug
|
Sep
(1) |
Oct
(1) |
Nov
(12) |
Dec
(2) |
| 2013 |
Jan
(1) |
Feb
(17) |
Mar
(4) |
Apr
(4) |
May
(9) |
Jun
|
Jul
(8) |
Aug
|
Sep
(2) |
Oct
|
Nov
|
Dec
|
|
From: Duncan C. <dun...@us...> - 2005-04-02 19:22:43
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20075 Modified Files: ChangeLog Log Message: Various minor changes merged in from the generated code. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.414 retrieving revision 1.415 diff -u -d -r1.414 -r1.415 --- ChangeLog 2 Apr 2005 19:07:59 -0000 1.414 +++ ChangeLog 2 Apr 2005 19:22:02 -0000 1.415 @@ -46,6 +46,13 @@ * gtk/Graphics/UI/Gtk/Buttons/RadioButton.chs: code formatting changes. + * gtk/Graphics/UI/Gtk/Entry/Editable.chs.pp, + gtk/Graphics/UI/Gtk/Entry/Entry.chs.pp, + gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp, + gtk/Graphics/UI/Gtk/Entry/HScale.chs, + gtk/Graphics/UI/Gtk/Entry/SpinButton.chs, + gtk/Graphics/UI/Gtk/Entry/VScale.chs: various minor changes. + 2005-04-1 Duncan Coutts <du...@co...> * tools/apiGen/ModuleScan.hs, tools/apiGen/ApiGen.hs, |
|
From: Duncan C. <dun...@us...> - 2005-04-02 19:22:28
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Entry In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20075/gtk/Graphics/UI/Gtk/Entry Modified Files: Editable.chs.pp Entry.chs.pp EntryCompletion.chs.pp HScale.chs SpinButton.chs VScale.chs Log Message: Various minor changes merged in from the generated code. Index: SpinButton.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Entry/SpinButton.chs,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- SpinButton.chs 15 Mar 2005 19:59:12 -0000 1.6 +++ SpinButton.chs 2 Apr 2005 19:22:04 -0000 1.7 @@ -24,11 +24,10 @@ -- Stability : provisional -- Portability : portable (depends on GHC) -- --- A spin button provides the possiblity to enter a numeric value without using --- the keyboard. +-- Retrieve an integer or floating-point number from the user -- module Graphics.UI.Gtk.Entry.SpinButton ( --- * Description +-- * Detail -- -- | A 'SpinButton' is an ideal way to allow the user to set the value of some -- attribute. Rather than having to directly type a number into a 'Entry', @@ -132,7 +131,8 @@ -> Int -- ^ @digits@ - the number of decimal places to display. -> IO SpinButton spinButtonNew adjustment climbRate digits = - makeNewObject mkSpinButton $ liftM castPtr $ + makeNewObject mkSpinButton $ + liftM (castPtr :: Ptr Widget -> Ptr SpinButton) $ {# call unsafe spin_button_new #} adjustment (realToFrac climbRate) @@ -150,7 +150,8 @@ -- widget -> IO SpinButton spinButtonNewWithRange min max step = - makeNewObject mkSpinButton $ liftM castPtr $ + makeNewObject mkSpinButton $ + liftM (castPtr :: Ptr Widget -> Ptr SpinButton) $ {# call unsafe spin_button_new_with_range #} (realToFrac min) (realToFrac max) @@ -234,7 +235,7 @@ -- 'spinButtonSetIncrements'. -- spinButtonGetIncrements :: SpinButtonClass self => self - -> IO (Double, Double) -- ^ @(step, page)@ + -> IO (Double, Double) -- ^ @(step, page)@ - step increment and page increment spinButtonGetIncrements self = alloca $ \stepPtr -> alloca $ \pagePtr -> do @@ -261,7 +262,7 @@ -- | Gets the range allowed for the spin button. See 'spinButtonSetRange'. -- spinButtonGetRange :: SpinButtonClass self => self - -> IO (Double, Double) -- ^ @(min, max)@ + -> IO (Double, Double) -- ^ @(min, max)@ - minimum and maximum allowed value spinButtonGetRange self = alloca $ \minPtr -> alloca $ \maxPtr -> do @@ -273,7 +274,7 @@ max <- peek maxPtr return (realToFrac min, realToFrac max) --- | Retrieve the current value of the spin button as a floating point value. +-- | Get the value of the spin button as a floating point value. -- spinButtonGetValue :: SpinButtonClass self => self -> IO Double spinButtonGetValue self = @@ -281,7 +282,7 @@ {# call unsafe spin_button_get_value #} (toSpinButton self) --- | Retrieve the current value of the spin button as an integral value. +-- | Get the value of the spin button as an integral value. -- spinButtonGetValueAsInt :: SpinButtonClass self => self -> IO Int spinButtonGetValueAsInt self = @@ -289,7 +290,7 @@ {# call unsafe spin_button_get_value_as_int #} (toSpinButton self) --- | Set the value of the SpinButton. +-- | Set the value of the spin button. -- spinButtonSetValue :: SpinButtonClass self => self -> Double -> IO () spinButtonSetValue self value = @@ -409,7 +410,7 @@ -- | The adjustment that holds the value of the spinbutton. -- -spinButtonAdjustment :: Attr SpinButton Adjustment +spinButtonAdjustment :: SpinButtonClass self => Attr self Adjustment spinButtonAdjustment = Attr spinButtonGetAdjustment spinButtonSetAdjustment @@ -420,7 +421,7 @@ -- -- Default value: 0 -- -spinButtonDigits :: Attr SpinButton Int +spinButtonDigits :: SpinButtonClass self => Attr self Int spinButtonDigits = Attr spinButtonGetDigits spinButtonSetDigits @@ -430,7 +431,7 @@ -- -- Default value: @False@ -- -spinButtonSnapToTicks :: Attr SpinButton Bool +spinButtonSnapToTicks :: SpinButtonClass self => Attr self Bool spinButtonSnapToTicks = Attr spinButtonGetSnapToTicks spinButtonSetSnapToTicks @@ -439,7 +440,7 @@ -- -- Default value: @False@ -- -spinButtonNumeric :: Attr SpinButton Bool +spinButtonNumeric :: SpinButtonClass self => Attr self Bool spinButtonNumeric = Attr spinButtonGetNumeric spinButtonSetNumeric @@ -448,7 +449,7 @@ -- -- Default value: @False@ -- -spinButtonWrap :: Attr SpinButton Bool +spinButtonWrap :: SpinButtonClass self => Attr self Bool spinButtonWrap = Attr spinButtonGetWrap spinButtonSetWrap @@ -458,7 +459,7 @@ -- -- Default value: 'UpdateAlways' -- -spinButtonUpdatePolicy :: Attr SpinButton SpinButtonUpdatePolicy +spinButtonUpdatePolicy :: SpinButtonClass self => Attr self SpinButtonUpdatePolicy spinButtonUpdatePolicy = Attr spinButtonGetUpdatePolicy spinButtonSetUpdatePolicy @@ -467,7 +468,7 @@ -- -- Default value: 0 -- -spinButtonValue :: Attr SpinButton Double +spinButtonValue :: SpinButtonClass self => Attr self Double spinButtonValue = Attr spinButtonGetValue spinButtonSetValue @@ -489,14 +490,14 @@ (Just val) -> do poke dPtr ((realToFrac val)::{#type gdouble#}) return 0 - Nothing -> return (toInteger inputError) + Nothing -> return (fromIntegral inputError) afterInput sb user = connect_PTR__INT "input" True sb $ \dPtr -> do mVal <- user case mVal of (Just val) -> do poke dPtr ((realToFrac val)::{#type gdouble#}) return 0 - Nothing -> return (toInteger inputError) + Nothing -> return (fromIntegral inputError) -- | Install a custom output handler. -- Index: Editable.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Entry/Editable.chs.pp,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- Editable.chs.pp 15 Mar 2005 20:19:56 -0000 1.6 +++ Editable.chs.pp 2 Apr 2005 19:22:03 -0000 1.7 @@ -138,18 +138,19 @@ -- | Inserts text at a given position. -- editableInsertText :: EditableClass self => self - -> String -- ^ @newText@ - the text to insert. - -> Int -- ^ @position@ - the position at which to insert the text. - -> IO Int -- ^ returns the position after the newly inserted text. + -> String -- ^ @newText@ - the text to insert. + -> Int -- ^ @position@ - the position at which to insert the text. + -> IO Int -- ^ returns the position after the newly inserted text. editableInsertText self newText position = - withObject (fromIntegral position) $ \positionPtr -> + with (fromIntegral position) $ \positionPtr -> withUTFStringLen newText $ \(newTextPtr, newTextLength) -> do {# call editable_insert_text #} (toEditable self) newTextPtr (fromIntegral newTextLength) positionPtr - liftM fromIntegral $ peek positionPtr + position <- peek positionPtr + return (fromIntegral position) -- | Deletes a sequence of characters. The characters that are deleted are -- those characters at positions from @startPos@ up to, but not including @@ -266,7 +267,7 @@ -- | \'position\' property. See 'editableGetPosition' and -- 'editableSetPosition' -- -editablePosition :: Attr Editable Int +editablePosition :: EditableClass self => Attr self Int editablePosition = Attr editableGetPosition editableSetPosition @@ -274,7 +275,7 @@ -- | \'editable\' property. See 'editableGetEditable' and -- 'editableSetEditable' -- -editableEditable :: Attr Editable Bool +editableEditable :: EditableClass self => Attr self Bool editableEditable = Attr editableGetEditable editableSetEditable Index: HScale.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Entry/HScale.chs,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- HScale.chs 15 Mar 2005 19:59:12 -0000 1.4 +++ HScale.chs 2 Apr 2005 19:22:04 -0000 1.5 @@ -75,7 +75,8 @@ -- the scale. -> IO HScale hScaleNew adjustment = - makeNewObject mkHScale $ liftM castPtr $ + makeNewObject mkHScale $ + liftM (castPtr :: Ptr Widget -> Ptr HScale) $ {# call unsafe hscale_new #} adjustment @@ -91,7 +92,8 @@ -- shortcuts -> IO HScale hScaleNewWithRange min max step = - makeNewObject mkHScale $ liftM castPtr $ + makeNewObject mkHScale $ + liftM (castPtr :: Ptr Widget -> Ptr HScale) $ {# call unsafe hscale_new_with_range #} (realToFrac min) (realToFrac max) Index: Entry.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Entry/Entry.chs.pp,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- Entry.chs.pp 15 Mar 2005 19:59:12 -0000 1.6 +++ Entry.chs.pp 2 Apr 2005 19:22:04 -0000 1.7 @@ -133,7 +133,8 @@ -- entryNew :: IO Entry entryNew = - makeNewObject mkEntry $ liftM castPtr $ + makeNewObject mkEntry $ + liftM (castPtr :: Ptr Widget -> Ptr Entry) $ {# call unsafe entry_new #} -------------------- @@ -306,7 +307,7 @@ (toEntry self) (fromBool setting) --- | Retrieve the number of characters the widget should ask for. +-- | Gets the value set by 'entrySetWidthChars'. -- entryGetWidthChars :: EntryClass self => self -> IO Int -- ^ returns number of chars to request space for, or negative if @@ -394,7 +395,7 @@ -- -- Default value: 0 -- -entryMaxLength :: Attr Entry Int +entryMaxLength :: EntryClass self => Attr self Int entryMaxLength = Attr entryGetMaxLength entrySetMaxLength @@ -404,7 +405,7 @@ -- -- Default value: @True@ -- -entryVisibility :: Attr Entry Bool +entryVisibility :: EntryClass self => Attr self Bool entryVisibility = Attr entryGetVisibility entrySetVisibility @@ -413,7 +414,7 @@ -- -- Default value: @True@ -- -entryHasFrame :: Attr Entry Bool +entryHasFrame :: EntryClass self => Attr self Bool entryHasFrame = Attr entryGetHasFrame entrySetHasFrame @@ -422,7 +423,7 @@ -- -- Default value: \'*\' -- -entryInvisibleChar :: Attr Entry Char +entryInvisibleChar :: EntryClass self => Attr self Char entryInvisibleChar = Attr entryGetInvisibleChar entrySetInvisibleChar @@ -432,7 +433,7 @@ -- -- Default value: @False@ -- -entryActivatesDefault :: Attr Entry Bool +entryActivatesDefault :: EntryClass self => Attr self Bool entryActivatesDefault = Attr entryGetActivatesDefault entrySetActivatesDefault @@ -443,7 +444,7 @@ -- -- Default value: -1 -- -entryWidthChars :: Attr Entry Int +entryWidthChars :: EntryClass self => Attr self Int entryWidthChars = Attr entryGetWidthChars entrySetWidthChars @@ -452,14 +453,14 @@ -- -- Default value: \"\" -- -entryText :: Attr Entry String +entryText :: EntryClass self => Attr self String entryText = Attr entryGetText entrySetText -- | \'alignment\' property. See 'entryGetAlignment' and 'entrySetAlignment' -- -entryAlignment :: Attr Entry Float +entryAlignment :: EntryClass self => Attr self Float entryAlignment = Attr entryGetAlignment entrySetAlignment @@ -467,7 +468,7 @@ -- | \'completion\' property. See 'entryGetCompletion' and -- 'entrySetCompletion' -- -entryCompletion :: Attr Entry EntryCompletion +entryCompletion :: EntryClass self => Attr self EntryCompletion entryCompletion = Attr entryGetCompletion entrySetCompletion Index: VScale.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Entry/VScale.chs,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- VScale.chs 15 Mar 2005 19:59:12 -0000 1.4 +++ VScale.chs 2 Apr 2005 19:22:04 -0000 1.5 @@ -75,7 +75,8 @@ -- the scale. -> IO VScale vScaleNew adjustment = - makeNewObject mkVScale $ liftM castPtr $ + makeNewObject mkVScale $ + liftM (castPtr :: Ptr Widget -> Ptr VScale) $ {# call unsafe vscale_new #} adjustment @@ -91,7 +92,8 @@ -- shortcuts. Must be nonzero. -> IO VScale vScaleNewWithRange min max step = - makeNewObject mkVScale $ liftM castPtr $ + makeNewObject mkVScale $ + liftM (castPtr :: Ptr Widget -> Ptr VScale) $ {# call unsafe vscale_new_with_range #} (realToFrac min) (realToFrac max) Index: EntryCompletion.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- EntryCompletion.chs.pp 15 Mar 2005 19:59:12 -0000 1.7 +++ EntryCompletion.chs.pp 2 Apr 2005 19:22:04 -0000 1.8 @@ -24,7 +24,7 @@ -- Stability : provisional -- Portability : portable (depends on GHC) -- --- Completion functionality for the 'Entry' widget. +-- Completion functionality for 'Entry' -- -- * Module available since Gtk+ version 2.4 -- @@ -114,7 +114,7 @@ -- entryCompletionNew :: IO EntryCompletion entryCompletionNew = - makeNewGObject mkEntryCompletion $ liftM castPtr $ + makeNewGObject mkEntryCompletion $ {# call gtk_entry_completion_new #} -------------------- @@ -275,7 +275,7 @@ -- | Minimum length of the search key in order to look up matches. -- --- Allowed values: >= -1 +-- Allowed values: >= 0 -- -- Default value: 1 -- |
|
From: Duncan C. <dun...@us...> - 2005-04-02 19:08:27
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11862 Modified Files: ChangeLog Log Message: Minor changes. Attributes and casts. For RadioButton, code formatting changes. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.413 retrieving revision 1.414 diff -u -d -r1.413 -r1.414 --- ChangeLog 2 Apr 2005 19:02:21 -0000 1.413 +++ ChangeLog 2 Apr 2005 19:07:59 -0000 1.414 @@ -38,6 +38,14 @@ * gtk/Graphics/UI/Gtk/Abstract/ButtonBox.chs.pp: rename attribute buttonBoxLayout to buttonBoxLayoutStyle. + * gtk/Graphics/UI/Gtk/Buttons/Button.chs.pp, + gtk/Graphics/UI/Gtk/Buttons/CheckButton.chs, + gtk/Graphics/UI/Gtk/Buttons/ToggleButton.chs: minor changes. + Attributes and casts. + + * gtk/Graphics/UI/Gtk/Buttons/RadioButton.chs: code formatting + changes. + 2005-04-1 Duncan Coutts <du...@co...> * tools/apiGen/ModuleScan.hs, tools/apiGen/ApiGen.hs, |
|
From: Duncan C. <dun...@us...> - 2005-04-02 19:08:15
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Buttons In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11862/gtk/Graphics/UI/Gtk/Buttons Modified Files: Button.chs.pp CheckButton.chs ToggleButton.chs RadioButton.chs Log Message: Minor changes. Attributes and casts. For RadioButton, code formatting changes. Index: RadioButton.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Buttons/RadioButton.chs,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- RadioButton.chs 25 Feb 2005 01:11:32 -0000 1.3 +++ RadioButton.chs 2 Apr 2005 19:08:01 -0000 1.4 @@ -30,10 +30,10 @@ -- Stability : provisional -- Portability : portable (depends on GHC) -- --- A choice from multiple check buttons. +-- A choice from multiple check buttons -- module Graphics.UI.Gtk.Buttons.RadioButton ( --- * Description +-- * Detail -- -- | A single radio button performs the same basic function as a -- 'CheckButton', as its position in the object hierarchy reflects. It is only @@ -97,23 +97,34 @@ -- | Create a new RadioButton widget with a new group. -- radioButtonNew :: IO RadioButton -radioButtonNew = makeNewObject mkRadioButton $ liftM castPtr $ - {#call unsafe radio_button_new#} nullPtr +radioButtonNew = + makeNewObject mkRadioButton $ + liftM (castPtr :: Ptr Widget -> Ptr RadioButton) $ + {# call unsafe radio_button_new #} + nullPtr -- | Like 'radioButtonNew' but shows a label to the right of the button. -- radioButtonNewWithLabel :: String -> IO RadioButton -radioButtonNewWithLabel lbl = withUTFString lbl $ \strPtr -> - makeNewObject mkRadioButton $ liftM castPtr $ - {#call unsafe radio_button_new_with_label#} nullPtr strPtr +radioButtonNewWithLabel label = + makeNewObject mkRadioButton $ + liftM (castPtr :: Ptr Widget -> Ptr RadioButton) $ + withUTFString label $ \labelPtr -> + {# call unsafe radio_button_new_with_label #} + nullPtr + labelPtr -- | Like 'radioButtonNew' but shows a label to the right of the button. -- Underscores in the label string indicate the mnemonic for the menu item. -- radioButtonNewWithMnemonic :: String -> IO RadioButton -radioButtonNewWithMnemonic lbl = withUTFString lbl $ \strPtr -> - makeNewObject mkRadioButton $ liftM castPtr $ - {#call unsafe radio_button_new_with_mnemonic#} nullPtr strPtr +radioButtonNewWithMnemonic label = + makeNewObject mkRadioButton $ + liftM (castPtr :: Ptr Widget -> Ptr RadioButton) $ + withUTFString label $ \labelPtr -> + {# call unsafe radio_button_new_with_mnemonic #} + nullPtr + labelPtr -- | Creates a new RadioButton and attaches it to the group of another radio -- button. @@ -123,23 +134,34 @@ -- mechanism. -- radioButtonNewJoinGroup :: RadioButton -> IO RadioButton -radioButtonNewJoinGroup rb = makeNewObject mkRadioButton $ liftM castPtr $ - {#call radio_button_new_from_widget#} rb +radioButtonNewJoinGroup rb = + makeNewObject mkRadioButton $ + liftM (castPtr :: Ptr Widget -> Ptr RadioButton) $ + {# call radio_button_new_from_widget #} + rb -- | Create a new RadioButton with a label and group. -- radioButtonNewJoinGroupWithLabel :: RadioButton -> String -> IO RadioButton -radioButtonNewJoinGroupWithLabel rb lbl = withUTFString lbl $ \strPtr -> - makeNewObject mkRadioButton $ liftM castPtr $ - {#call radio_button_new_with_label_from_widget#} rb strPtr +radioButtonNewJoinGroupWithLabel rb label = + makeNewObject mkRadioButton $ + liftM (castPtr :: Ptr Widget -> Ptr RadioButton) $ + withUTFString label $ \labelPtr -> + {# call radio_button_new_with_label_from_widget #} + rb + labelPtr -- | Create a new RadioButton with a label and group. Underscores in the label -- string indicate the mnemonic for the menu item. -- radioButtonNewJoinGroupWithMnemonic :: RadioButton -> String -> IO RadioButton -radioButtonNewJoinGroupWithMnemonic rb lbl = withUTFString lbl $ \strPtr -> - makeNewObject mkRadioButton $ liftM castPtr $ - {#call radio_button_new_with_mnemonic_from_widget#} rb strPtr +radioButtonNewJoinGroupWithMnemonic rb label = + makeNewObject mkRadioButton $ + liftM (castPtr :: Ptr Widget -> Ptr RadioButton) $ + withUTFString label $ \labelPtr -> + {# call radio_button_new_with_mnemonic_from_widget #} + rb + labelPtr -- | Alias for 'radioButtonNewJoinGroup'. Index: CheckButton.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Buttons/CheckButton.chs,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- CheckButton.chs 15 Mar 2005 19:47:47 -0000 1.4 +++ CheckButton.chs 2 Apr 2005 19:08:01 -0000 1.5 @@ -77,7 +77,8 @@ -- checkButtonNew :: IO CheckButton checkButtonNew = - makeNewObject mkCheckButton $ liftM castPtr $ + makeNewObject mkCheckButton $ + liftM (castPtr :: Ptr Widget -> Ptr CheckButton) $ {# call unsafe check_button_new #} -- | Creates a new 'CheckButton' with a 'Label' to the right of it. @@ -86,7 +87,8 @@ String -- ^ @label@ - the text for the check button. -> IO CheckButton checkButtonNewWithLabel label = - makeNewObject mkCheckButton $ liftM castPtr $ + makeNewObject mkCheckButton $ + liftM (castPtr :: Ptr Widget -> Ptr CheckButton) $ withUTFString label $ \labelPtr -> {# call unsafe check_button_new_with_label #} labelPtr @@ -100,7 +102,8 @@ -- in front of the mnemonic character -> IO CheckButton checkButtonNewWithMnemonic label = - makeNewObject mkCheckButton $ liftM castPtr $ + makeNewObject mkCheckButton $ + liftM (castPtr :: Ptr Widget -> Ptr CheckButton) $ withUTFString label $ \labelPtr -> {# call unsafe check_button_new_with_mnemonic #} labelPtr Index: ToggleButton.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Buttons/ToggleButton.chs,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- ToggleButton.chs 15 Mar 2005 19:47:47 -0000 1.5 +++ ToggleButton.chs 2 Apr 2005 19:08:01 -0000 1.6 @@ -104,7 +104,8 @@ -- toggleButtonNew :: IO ToggleButton toggleButtonNew = - makeNewObject mkToggleButton $ liftM castPtr $ + makeNewObject mkToggleButton $ + liftM (castPtr :: Ptr Widget -> Ptr ToggleButton) $ {# call unsafe toggle_button_new #} -- | Creates a new toggle button with a text label. @@ -114,7 +115,8 @@ -- placed in the toggle button. -> IO ToggleButton toggleButtonNewWithLabel label = - makeNewObject mkToggleButton $ liftM castPtr $ + makeNewObject mkToggleButton $ + liftM (castPtr :: Ptr Widget -> Ptr ToggleButton) $ withUTFString label $ \labelPtr -> {# call unsafe toggle_button_new_with_label #} labelPtr @@ -128,7 +130,8 @@ -- in front of the mnemonic character -> IO ToggleButton toggleButtonNewWithMnemonic label = - makeNewObject mkToggleButton $ liftM castPtr $ + makeNewObject mkToggleButton $ + liftM (castPtr :: Ptr Widget -> Ptr ToggleButton) $ withUTFString label $ \labelPtr -> {# call unsafe toggle_button_new_with_mnemonic #} labelPtr @@ -176,8 +179,7 @@ -- | Queries a 'ToggleButton' and returns its current state. Returns @True@ if -- the toggle button is pressed in and @False@ if it is raised. -- -toggleButtonGetActive :: ToggleButtonClass self => self - -> IO Bool +toggleButtonGetActive :: ToggleButtonClass self => self -> IO Bool toggleButtonGetActive self = liftM toBool $ {# call unsafe toggle_button_get_active #} @@ -229,7 +231,7 @@ -- -- Default value: @False@ -- -toggleButtonActive :: Attr ToggleButton Bool +toggleButtonActive :: ToggleButtonClass self => Attr self Bool toggleButtonActive = Attr toggleButtonGetActive toggleButtonSetActive @@ -238,14 +240,14 @@ -- -- Default value: @False@ -- -toggleButtonInconsistent :: Attr ToggleButton Bool +toggleButtonInconsistent :: ToggleButtonClass self => Attr self Bool toggleButtonInconsistent = Attr toggleButtonGetInconsistent toggleButtonSetInconsistent -- | \'mode\' property. See 'toggleButtonGetMode' and 'toggleButtonSetMode' -- -toggleButtonMode :: Attr ToggleButton Bool +toggleButtonMode :: ToggleButtonClass self => Attr self Bool toggleButtonMode = Attr toggleButtonGetMode toggleButtonSetMode Index: Button.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Buttons/Button.chs.pp,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- Button.chs.pp 15 Mar 2005 19:47:31 -0000 1.5 +++ Button.chs.pp 2 Apr 2005 19:08:00 -0000 1.6 @@ -126,7 +126,8 @@ -- buttonNew :: IO Button buttonNew = - makeNewObject mkButton $ liftM castPtr $ + makeNewObject mkButton $ + liftM (castPtr :: Ptr Widget -> Ptr Button) $ {# call unsafe button_new #} -- | Creates a 'Button' widget with a 'Label' child containing the given text. @@ -135,7 +136,8 @@ String -- ^ @label@ - The text you want the 'Label' to hold. -> IO Button buttonNewWithLabel label = - makeNewObject mkButton $ liftM castPtr $ + makeNewObject mkButton $ + liftM (castPtr :: Ptr Widget -> Ptr Button) $ withUTFString label $ \labelPtr -> {# call unsafe button_new_with_label #} labelPtr @@ -151,7 +153,8 @@ -- front of the mnemonic character -> IO Button buttonNewWithMnemonic label = - makeNewObject mkButton $ liftM castPtr $ + makeNewObject mkButton $ + liftM (castPtr :: Ptr Widget -> Ptr Button) $ withUTFString label $ \labelPtr -> {# call unsafe button_new_with_mnemonic #} labelPtr @@ -165,7 +168,8 @@ String -- ^ @stockId@ - the name of the stock item -> IO Button buttonNewFromStock stockId = - makeNewObject mkButton $ liftM castPtr $ + makeNewObject mkButton $ + liftM (castPtr :: Ptr Widget -> Ptr Button) $ withUTFString stockId $ \stockIdPtr -> throwIfNull "buttonNewFromStock: Invalid stock identifier." $ {# call unsafe button_new_from_stock #} @@ -340,7 +344,7 @@ (toButton self) -- | Sets the alignment of the child. This has no effect unless the child --- derives from 'Misc' 'Aligment'. +-- derives from 'Misc' or 'Aligment'. -- -- * Available since Gtk version 2.4 -- @@ -361,7 +365,7 @@ -- * Available since Gtk version 2.4 -- buttonGetAlignment :: ButtonClass self => self - -> IO (Float, Float) -- ^ @(xalign,yalign)@ - horizontal and vertical + -> IO (Float, Float) -- ^ @(xalign, yalign)@ - horizontal and vertical -- alignment buttonGetAlignment self = alloca $ \xalignPtr -> @@ -383,7 +387,7 @@ -- -- Default value: @False@ -- -buttonUseUnderline :: Attr Button Bool +buttonUseUnderline :: ButtonClass self => Attr self Bool buttonUseUnderline = Attr buttonGetUseUnderline buttonSetUseUnderline @@ -393,7 +397,7 @@ -- -- Default value: @False@ -- -buttonUseStock :: Attr Button Bool +buttonUseStock :: ButtonClass self => Attr self Bool buttonUseStock = Attr buttonGetUseStock buttonSetUseStock @@ -402,7 +406,7 @@ -- -- Default value: @True@ -- -buttonFocusOnClick :: Attr Button Bool +buttonFocusOnClick :: ButtonClass self => Attr self Bool buttonFocusOnClick = Attr buttonGetFocusOnClick buttonSetFocusOnClick @@ -411,7 +415,7 @@ -- -- Default value: 'ReliefNormal' -- -buttonRelief :: Attr Button ReliefStyle +buttonRelief :: ButtonClass self => Attr self ReliefStyle buttonRelief = Attr buttonGetRelief buttonSetRelief |
|
From: Duncan C. <dun...@us...> - 2005-04-02 19:02:48
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Abstract In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8408/gtk/Graphics/UI/Gtk/Abstract Modified Files: Box.chs Object.chs.pp Paned.chs.pp Range.chs Scale.chs ButtonBox.chs.pp Log Message: Minor changes. Mostly generalising the types of attributes. For ButtonBox, rename attribute buttonBoxLayout to buttonBoxLayoutStyle. Index: Range.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Abstract/Range.chs,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- Range.chs 15 Mar 2005 19:49:40 -0000 1.7 +++ Range.chs 2 Apr 2005 19:02:23 -0000 1.8 @@ -221,14 +221,14 @@ -- -- Default value: 'UpdateContinuous' -- -rangeUpdatePolicy :: Attr Range UpdateType +rangeUpdatePolicy :: RangeClass self => Attr self UpdateType rangeUpdatePolicy = Attr rangeGetUpdatePolicy rangeSetUpdatePolicy -- | The 'Adjustment' that contains the current value of this range object. -- -rangeAdjustment :: Attr Range Adjustment +rangeAdjustment :: RangeClass self => Attr self Adjustment rangeAdjustment = Attr rangeGetAdjustment rangeSetAdjustment @@ -237,14 +237,14 @@ -- -- Default value: @False@ -- -rangeInverted :: Attr Range Bool +rangeInverted :: RangeClass self => Attr self Bool rangeInverted = Attr rangeGetInverted rangeSetInverted -- | \'value\' property. See 'rangeGetValue' and 'rangeSetValue' -- -rangeValue :: Attr Range Double +rangeValue :: RangeClass self => Attr self Double rangeValue = Attr rangeGetValue rangeSetValue Index: Object.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Abstract/Object.chs.pp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- Object.chs.pp 25 Feb 2005 01:11:31 -0000 1.3 +++ Object.chs.pp 2 Apr 2005 19:02:22 -0000 1.4 @@ -31,7 +31,7 @@ -- in each widget file. -- module Graphics.UI.Gtk.Abstract.Object ( --- * Description +-- * Detail -- -- | 'Object' is the base class for all widgets, and for a few non-widget -- objects such as 'Adjustment'. 'Object' predates 'GObject'; non-widgets that Index: ButtonBox.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Abstract/ButtonBox.chs.pp,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- ButtonBox.chs.pp 14 Mar 2005 23:55:07 -0000 1.5 +++ ButtonBox.chs.pp 2 Apr 2005 19:02:23 -0000 1.6 @@ -74,7 +74,7 @@ #endif -- * Properties - buttonBoxLayout + buttonBoxLayoutStyle ) where import Monad (liftM) @@ -93,8 +93,7 @@ -- | Retrieves the method being used to arrange the buttons in the button box. -- -buttonBoxGetLayout :: ButtonBoxClass self => self - -> IO ButtonBoxStyle +buttonBoxGetLayout :: ButtonBoxClass self => self -> IO ButtonBoxStyle buttonBoxGetLayout self = liftM (toEnum . fromIntegral) $ {# call gtk_button_box_get_layout #} @@ -130,9 +129,9 @@ -- typical use of a secondary child is the help button in a dialog. -- -- This group appears after the other children if the style is --- 'ButtonboxStart', 'ButtonboxSpread' or 'ButtonboxEdge', and before the the --- other children if the style is 'ButtonboxEnd'. For horizontal button boxes, --- the definition of before\/after depends on direction of the widget (see +-- 'ButtonboxStart', 'ButtonboxSpread' or 'ButtonboxEdge', and before the other +-- children if the style is 'ButtonboxEnd'. For horizontal button boxes, the +-- definition of before\/after depends on direction of the widget (see -- 'widgetSetDirection'). If the style is 'ButtonboxStart' or 'ButtonboxEnd', -- then the secondary children are aligned at the other end of the button box -- from the main children. For the other styles, they appear immediately next @@ -157,7 +156,7 @@ -- -- Default value: 'ButtonboxDefaultStyle' -- -buttonBoxLayout :: Attr ButtonBox ButtonBoxStyle -buttonBoxLayout = Attr +buttonBoxLayoutStyle :: ButtonBoxClass self => Attr self ButtonBoxStyle +buttonBoxLayoutStyle = Attr buttonBoxGetLayout buttonBoxSetLayout Index: Paned.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Abstract/Paned.chs.pp,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- Paned.chs.pp 14 Mar 2005 23:55:07 -0000 1.6 +++ Paned.chs.pp 2 Apr 2005 19:02:22 -0000 1.7 @@ -205,7 +205,7 @@ -- -- Default value: 0 -- -panedPosition :: Attr Paned Int +panedPosition :: PanedClass self => Attr self Int panedPosition = Attr panedGetPosition panedSetPosition Index: Box.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Abstract/Box.chs,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- Box.chs 14 Mar 2005 23:55:07 -0000 1.6 +++ Box.chs 2 Apr 2005 19:02:21 -0000 1.7 @@ -323,7 +323,7 @@ -- -- Default value: 0 -- -boxSpacing :: Attr Box Int +boxSpacing :: BoxClass self => Attr self Int boxSpacing = Attr boxGetSpacing boxSetSpacing @@ -332,7 +332,7 @@ -- -- Default value: @False@ -- -boxHomogeneous :: Attr Box Bool +boxHomogeneous :: BoxClass self => Attr self Bool boxHomogeneous = Attr boxGetHomogeneous boxSetHomogeneous Index: Scale.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Abstract/Scale.chs,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- Scale.chs 14 Mar 2005 23:55:07 -0000 1.6 +++ Scale.chs 2 Apr 2005 19:02:23 -0000 1.7 @@ -158,7 +158,7 @@ -- -- Default value: 1 -- -scaleDigits :: Attr Scale Int +scaleDigits :: ScaleClass self => Attr self Int scaleDigits = Attr scaleGetDigits scaleSetDigits @@ -167,7 +167,7 @@ -- -- Default value: @False@ -- -scaleDrawValue :: Attr Scale Bool +scaleDrawValue :: ScaleClass self => Attr self Bool scaleDrawValue = Attr scaleGetDrawValue scaleSetDrawValue @@ -176,7 +176,7 @@ -- -- Default value: 'PosLeft' -- -scaleValuePos :: Attr Scale PositionType +scaleValuePos :: ScaleClass self => Attr self PositionType scaleValuePos = Attr scaleGetValuePos scaleSetValuePos |
|
From: Duncan C. <dun...@us...> - 2005-04-02 19:02:30
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8408 Modified Files: ChangeLog Log Message: Minor changes. Mostly generalising the types of attributes. For ButtonBox, rename attribute buttonBoxLayout to buttonBoxLayoutStyle. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.412 retrieving revision 1.413 diff -u -d -r1.412 -r1.413 --- ChangeLog 2 Apr 2005 18:55:21 -0000 1.412 +++ ChangeLog 2 Apr 2005 19:02:21 -0000 1.413 @@ -28,6 +28,16 @@ * gtk/Graphics/UI/Gtk/Misc/Calendar.chs.pp: add property, export extra function as well as trivial code changes. + * gtk/Graphics/UI/Gtk/Abstract/Box.chs, + gtk/Graphics/UI/Gtk/Abstract/Object.chs.pp, + gtk/Graphics/UI/Gtk/Abstract/Paned.chs.pp, + gtk/Graphics/UI/Gtk/Abstract/Range.chs, + gtk/Graphics/UI/Gtk/Abstract/Scale.chs: minor changes. Mostly + generalising the types of attributes. + + * gtk/Graphics/UI/Gtk/Abstract/ButtonBox.chs.pp: rename attribute + buttonBoxLayout to buttonBoxLayoutStyle. + 2005-04-1 Duncan Coutts <du...@co...> * tools/apiGen/ModuleScan.hs, tools/apiGen/ApiGen.hs, |
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Misc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4568/gtk/Graphics/UI/Gtk/Misc Modified Files: Arrow.chs DrawingArea.chs EventBox.chs.pp HandleBox.chs SizeGroup.chs Tooltips.chs.pp Viewport.chs Calendar.chs.pp Log Message: Mostly trivial code changes. For Calendar, add property, export extra function. Index: DrawingArea.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Misc/DrawingArea.chs,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- DrawingArea.chs 16 Mar 2005 02:32:27 -0000 1.5 +++ DrawingArea.chs 2 Apr 2005 18:55:22 -0000 1.6 @@ -103,5 +103,6 @@ -- drawingAreaNew :: IO DrawingArea drawingAreaNew = - makeNewObject mkDrawingArea $ liftM castPtr $ + makeNewObject mkDrawingArea $ + liftM (castPtr :: Ptr Widget -> Ptr DrawingArea) $ {# call unsafe drawing_area_new #} Index: HandleBox.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Misc/HandleBox.chs,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- HandleBox.chs 16 Mar 2005 01:42:46 -0000 1.5 +++ HandleBox.chs 2 Apr 2005 18:55:22 -0000 1.6 @@ -108,7 +108,8 @@ -- handleBoxNew :: IO HandleBox handleBoxNew = - makeNewObject mkHandleBox $ liftM castPtr $ + makeNewObject mkHandleBox $ + liftM (castPtr :: Ptr Widget -> Ptr HandleBox) $ {# call unsafe handle_box_new #} -------------------- @@ -189,7 +190,7 @@ -- -- Default value: 'ShadowEtchedOut' -- -handleBoxShadowType :: Attr HandleBox ShadowType +handleBoxShadowType :: HandleBoxClass self => Attr self ShadowType handleBoxShadowType = Attr handleBoxGetShadowType handleBoxSetShadowType @@ -198,7 +199,7 @@ -- -- Default value: 'PosLeft' -- -handleBoxHandlePosition :: Attr HandleBox PositionType +handleBoxHandlePosition :: HandleBoxClass self => Attr self PositionType handleBoxHandlePosition = Attr handleBoxGetHandlePosition handleBoxSetHandlePosition @@ -208,7 +209,7 @@ -- -- Default value: 'PosTop' -- -handleBoxSnapEdge :: Attr HandleBox PositionType +handleBoxSnapEdge :: HandleBoxClass self => Attr self PositionType handleBoxSnapEdge = Attr handleBoxGetSnapEdge handleBoxSetSnapEdge Index: Arrow.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Misc/Arrow.chs,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- Arrow.chs 16 Mar 2005 01:42:46 -0000 1.2 +++ Arrow.chs 2 Apr 2005 18:55:22 -0000 1.3 @@ -81,12 +81,10 @@ -- | Creates a new arrow widget. -- -arrowNew :: - ArrowType - -> ShadowType - -> IO Arrow +arrowNew :: ArrowType -> ShadowType -> IO Arrow arrowNew arrowType shadowType = - makeNewObject mkArrow $ liftM castPtr $ + makeNewObject mkArrow $ + liftM (castPtr :: Ptr Widget -> Ptr Arrow) $ {# call unsafe arrow_new #} ((fromIntegral . fromEnum) arrowType) ((fromIntegral . fromEnum) shadowType) @@ -96,10 +94,7 @@ -- | Sets the direction and style of the 'Arrow'. -- -arrowSet :: ArrowClass self => self - -> ArrowType - -> ShadowType - -> IO () +arrowSet :: ArrowClass self => self -> ArrowType -> ShadowType -> IO () arrowSet self arrowType shadowType = {# call arrow_set #} (toArrow self) Index: EventBox.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Misc/EventBox.chs.pp,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- EventBox.chs.pp 16 Mar 2005 01:42:46 -0000 1.5 +++ EventBox.chs.pp 2 Apr 2005 18:55:22 -0000 1.6 @@ -83,7 +83,8 @@ -- eventBoxNew :: IO EventBox eventBoxNew = - makeNewObject mkEventBox $ liftM castPtr $ + makeNewObject mkEventBox $ + liftM (castPtr :: Ptr Widget -> Ptr EventBox) $ {# call unsafe event_box_new #} -------------------- Index: Tooltips.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Misc/Tooltips.chs.pp,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Tooltips.chs.pp 16 Mar 2005 01:42:46 -0000 1.4 +++ Tooltips.chs.pp 2 Apr 2005 18:55:23 -0000 1.5 @@ -98,7 +98,7 @@ -- tooltipsNew :: IO Tooltips tooltipsNew = - makeNewObject mkTooltips $ liftM castPtr $ + makeNewObject mkTooltips $ {# call unsafe tooltips_new #} -------------------- Index: Viewport.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Misc/Viewport.chs,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- Viewport.chs 16 Mar 2005 01:42:47 -0000 1.5 +++ Viewport.chs 2 Apr 2005 18:55:23 -0000 1.6 @@ -93,7 +93,8 @@ -> Adjustment -- ^ @vadjustment@ - vertical adjustment. -> IO Viewport viewportNew hadjustment vadjustment = - makeNewObject mkViewport $ liftM castPtr $ + makeNewObject mkViewport $ + liftM (castPtr :: Ptr Widget -> Ptr Viewport) $ {# call unsafe viewport_new #} hadjustment vadjustment @@ -103,8 +104,7 @@ -- | Returns the horizontal adjustment of the viewport. -- -viewportGetHAdjustment :: ViewportClass self => self - -> IO Adjustment +viewportGetHAdjustment :: ViewportClass self => self -> IO Adjustment viewportGetHAdjustment self = makeNewObject mkAdjustment $ {# call unsafe viewport_get_hadjustment #} @@ -112,8 +112,7 @@ -- | Returns the vertical adjustment of the viewport. -- -viewportGetVAdjustment :: ViewportClass self => self - -> IO Adjustment +viewportGetVAdjustment :: ViewportClass self => self -> IO Adjustment viewportGetVAdjustment self = makeNewObject mkAdjustment $ {# call unsafe viewport_get_vadjustment #} @@ -121,9 +120,7 @@ -- | Sets the horizontal adjustment of the viewport. -- -viewportSetHAdjustment :: ViewportClass self => self - -> Adjustment - -> IO () +viewportSetHAdjustment :: ViewportClass self => self -> Adjustment -> IO () viewportSetHAdjustment self adjustment = {# call viewport_set_hadjustment #} (toViewport self) @@ -131,9 +128,7 @@ -- | Sets the vertical adjustment of the viewport. -- -viewportSetVAdjustment :: ViewportClass self => self - -> Adjustment - -> IO () +viewportSetVAdjustment :: ViewportClass self => self -> Adjustment -> IO () viewportSetVAdjustment self adjustment = {# call viewport_set_vadjustment #} (toViewport self) @@ -164,7 +159,7 @@ -- | The 'Adjustment' that determines the values of the horizontal position -- for this viewport. -- -viewportHAdjustment :: Attr Viewport Adjustment +viewportHAdjustment :: ViewportClass self => Attr self Adjustment viewportHAdjustment = Attr viewportGetHAdjustment viewportSetHAdjustment @@ -172,7 +167,7 @@ -- | The 'Adjustment' that determines the values of the vertical position for -- this viewport. -- -viewportVAdjustment :: Attr Viewport Adjustment +viewportVAdjustment :: ViewportClass self => Attr self Adjustment viewportVAdjustment = Attr viewportGetVAdjustment viewportSetVAdjustment @@ -181,7 +176,7 @@ -- -- Default value: 'ShadowIn' -- -viewportShadowType :: Attr Viewport ShadowType +viewportShadowType :: ViewportClass self => Attr self ShadowType viewportShadowType = Attr viewportGetShadowType viewportSetShadowType Index: Calendar.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Misc/Calendar.chs.pp,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Calendar.chs.pp 16 Mar 2005 01:42:46 -0000 1.4 +++ Calendar.chs.pp 2 Apr 2005 18:55:23 -0000 1.5 @@ -79,6 +79,10 @@ calendarGetDisplayOptions, #endif calendarGetDate, + calendarFreeze, + +-- * Properties +-- calendarDisplayOptions, -- * Signals onDaySelected, @@ -114,7 +118,8 @@ -- calendarNew :: IO Calendar calendarNew = - makeNewObject mkCalendar $ liftM castPtr $ + makeNewObject mkCalendar $ + liftM (castPtr :: Ptr Widget -> Ptr Calendar) $ {# call unsafe calendar_new #} -------------------- @@ -209,8 +214,7 @@ -- newly-written code. Use 'calendarSetDisplayOptions' instead. -- calendarDisplayOptions :: CalendarClass self => self - -> [CalendarDisplayOptions] - -> IO () + -> [CalendarDisplayOptions] -> IO () calendarDisplayOptions self flags = {# call calendar_display_options #} (toCalendar self) @@ -223,7 +227,7 @@ -> IO (Int,Int,Int) -- ^ @(year, month, day)@ calendarGetDate self = alloca $ \yearPtr -> - alloca $ \monthPtr -> + alloca $ \monthPtr -> alloca $ \dayPtr -> do {# call unsafe calendar_get_date #} (toCalendar self) @@ -250,21 +254,32 @@ return res -------------------- +-- Properties + +-- | \'displayOptions\' property. See 'calendarGetDisplayOptions' and +-- 'calendarSetDisplayOptions' +-- +--calendarDisplayOptions :: CalendarClass self => Attr self [CalendarDisplayOptions] +--calendarDisplayOptions = Attr +-- calendarGetDisplayOptions +-- calendarSetDisplayOptions + +-------------------- -- Signals -- | Emitted when a day was selected. -- -onDaySelected, afterDaySelected :: CalendarClass c => c -> IO () -> - IO (ConnectId c) +onDaySelected, afterDaySelected :: CalendarClass self => self + -> IO () + -> IO (ConnectId self) onDaySelected = connect_NONE__NONE "day-selected" False afterDaySelected = connect_NONE__NONE "day-selected" True --- | Emitted when a day received a --- double click. +-- | Emitted when a day received a double click. -- -onDaySelectedDoubleClick, afterDaySelectedDoubleClick :: CalendarClass c => - c -> IO () -> - IO (ConnectId c) +onDaySelectedDoubleClick, afterDaySelectedDoubleClick :: CalendarClass self => self + -> IO () + -> IO (ConnectId self) onDaySelectedDoubleClick = connect_NONE__NONE "day-selected-double-click" False afterDaySelectedDoubleClick = @@ -272,33 +287,40 @@ -- | The month changed. -- -onMonthChanged, afterMonthChanged :: CalendarClass c => c -> IO () -> - IO (ConnectId c) +onMonthChanged, afterMonthChanged :: CalendarClass self => self + -> IO () + -> IO (ConnectId self) onMonthChanged = connect_NONE__NONE "month-changed" False afterMonthChanged = connect_NONE__NONE "month-changed" True -- | The next month was selected. -- -onNextMonth, afterNextMonth :: CalendarClass c => c -> IO () -> - IO (ConnectId c) +onNextMonth, afterNextMonth :: CalendarClass self => self + -> IO () + -> IO (ConnectId self) onNextMonth = connect_NONE__NONE "next-month" False afterNextMonth = connect_NONE__NONE "next-month" True -- | The next year was selected. -- -onNextYear, afterNextYear :: CalendarClass c => c -> IO () -> IO (ConnectId c) +onNextYear, afterNextYear :: CalendarClass self => self + -> IO () + -> IO (ConnectId self) onNextYear = connect_NONE__NONE "next-year" False afterNextYear = connect_NONE__NONE "next-year" True -- | The previous month was selected. -- -onPrevMonth, afterPrevMonth :: CalendarClass c => c -> IO () -> - IO (ConnectId c) +onPrevMonth, afterPrevMonth :: CalendarClass self => self + -> IO () + -> IO (ConnectId self) onPrevMonth = connect_NONE__NONE "prev-month" False afterPrevMonth = connect_NONE__NONE "prev-month" True -- | The previous year was selected. -- -onPrevYear, afterPrevYear :: CalendarClass c => c -> IO () -> IO (ConnectId c) +onPrevYear, afterPrevYear :: CalendarClass self => self + -> IO () + -> IO (ConnectId self) onPrevYear = connect_NONE__NONE "prev-year" False afterPrevYear = connect_NONE__NONE "prev-year" True Index: SizeGroup.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Misc/SizeGroup.chs,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- SizeGroup.chs 16 Mar 2005 01:42:46 -0000 1.6 +++ SizeGroup.chs 2 Apr 2005 18:55:23 -0000 1.7 @@ -163,7 +163,7 @@ -- -- Default value: 'SizeGroupHorizontal' -- -sizeGroupMode :: Attr SizeGroup SizeGroupMode +sizeGroupMode :: SizeGroupClass self => Attr self SizeGroupMode sizeGroupMode = Attr sizeGroupGetMode sizeGroupSetMode |
|
From: Duncan C. <dun...@us...> - 2005-04-02 18:55:34
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4568 Modified Files: ChangeLog Log Message: Mostly trivial code changes. For Calendar, add property, export extra function. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.411 retrieving revision 1.412 diff -u -d -r1.411 -r1.412 --- ChangeLog 2 Apr 2005 16:52:48 -0000 1.411 +++ ChangeLog 2 Apr 2005 18:55:21 -0000 1.412 @@ -17,6 +17,17 @@ the generated modules. Code formatting changes. Documentation changes. One or two actual code changes but nothing that affects the API. + * gtk/Graphics/UI/Gtk/Misc/Arrow.chs, + gtk/Graphics/UI/Gtk/Misc/DrawingArea.chs, + gtk/Graphics/UI/Gtk/Misc/EventBox.chs.pp, + gtk/Graphics/UI/Gtk/Misc/HandleBox.chs, + gtk/Graphics/UI/Gtk/Misc/SizeGroup.chs, + gtk/Graphics/UI/Gtk/Misc/Tooltips.chs.pp, + gtk/Graphics/UI/Gtk/Misc/Viewport.chs: mostly trivial code changes. + + * gtk/Graphics/UI/Gtk/Misc/Calendar.chs.pp: add property, export extra + function as well as trivial code changes. + 2005-04-1 Duncan Coutts <du...@co...> * tools/apiGen/ModuleScan.hs, tools/apiGen/ApiGen.hs, |
|
From: Duncan C. <dun...@us...> - 2005-04-02 16:52:59
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3378 Modified Files: ChangeLog Log Message: More merging from the generated modules. Code formatting changes. Documentation changes. One or two actual code changes but nothing that affects the API. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.410 retrieving revision 1.411 diff -u -d -r1.410 -r1.411 --- ChangeLog 1 Apr 2005 22:55:10 -0000 1.410 +++ ChangeLog 2 Apr 2005 16:52:48 -0000 1.411 @@ -1,3 +1,22 @@ +2005-04-2 Duncan Coutts <du...@co...> + + * gtk/Graphics/UI/Gtk/MenuComboToolbar/CheckMenuItem.chs.pp, + gtk/Graphics/UI/Gtk/MenuComboToolbar/Combo.chs.pp, + gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBox.chs.pp, + gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs.pp, + gtk/Graphics/UI/Gtk/MenuComboToolbar/ImageMenuItem.chs, + gtk/Graphics/UI/Gtk/MenuComboToolbar/Menu.chs.pp, + gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuBar.chs, + gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs, + gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuShell.chs, + gtk/Graphics/UI/Gtk/MenuComboToolbar/OptionMenu.chs.pp, + gtk/Graphics/UI/Gtk/MenuComboToolbar/RadioMenuItem.chs, + gtk/Graphics/UI/Gtk/MenuComboToolbar/TearoffMenuItem.chs, + gtk/Graphics/UI/Gtk/MenuComboToolbar/ToolItem.chs.pp, + gtk/Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs.pp: more merging from + the generated modules. Code formatting changes. Documentation changes. + One or two actual code changes but nothing that affects the API. + 2005-04-1 Duncan Coutts <du...@co...> * tools/apiGen/ModuleScan.hs, tools/apiGen/ApiGen.hs, |
|
From: Duncan C. <dun...@us...> - 2005-04-02 16:52:59
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/MenuComboToolbar In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3378/gtk/Graphics/UI/Gtk/MenuComboToolbar Modified Files: CheckMenuItem.chs.pp Combo.chs.pp ComboBox.chs.pp ComboBoxEntry.chs.pp ImageMenuItem.chs Menu.chs.pp MenuBar.chs MenuItem.chs MenuShell.chs OptionMenu.chs.pp RadioMenuItem.chs TearoffMenuItem.chs ToolItem.chs.pp Toolbar.chs.pp Log Message: More merging from the generated modules. Code formatting changes. Documentation changes. One or two actual code changes but nothing that affects the API. Index: Menu.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/MenuComboToolbar/Menu.chs.pp,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Menu.chs.pp 13 Mar 2005 19:34:35 -0000 1.4 +++ Menu.chs.pp 2 Apr 2005 16:52:49 -0000 1.5 @@ -34,12 +34,10 @@ -- Stability : provisional -- Portability : portable (depends on GHC) -- --- A Menu is a vertically aligned set of options that can be selected. There --- are two kinds: Those that are part of a 'MenuBar' and those --- that appear as a context menu (within the work space). +-- A menu widget -- module Graphics.UI.Gtk.MenuComboToolbar.Menu ( --- * Description +-- * Detail -- -- | A 'Menu' is a 'MenuShell' that implements a drop down menu consisting of -- a list of 'MenuItem' objects which can be navigated and activated by the @@ -119,160 +117,233 @@ -------------------- -- Constructors --- | Make an empty Menu. +-- | Creates a new 'Menu'. -- menuNew :: IO Menu -menuNew = makeNewObject mkMenu $ - liftM castPtr {#call unsafe menu_new#} +menuNew = + makeNewObject mkMenu $ + liftM (castPtr :: Ptr Widget -> Ptr Menu) $ + {# call unsafe menu_new #} -------------------- -- Methods --- | Move a child to a new position within the menu. --- --- * The position is counted from 0 to n-1 if the menu contains n entries. +-- | Moves a 'MenuItem' to a new position within the 'Menu'. -- -menuReorderChild :: (MenuClass m, MenuItemClass mi) => m -> mi -> Int -> IO () -menuReorderChild m child pos = {#call menu_reorder_child#} - (toMenu m) (toWidget child) (fromIntegral pos) +menuReorderChild :: (MenuClass self, MenuItemClass child) => self + -> child -- ^ @child@ - the 'MenuItem' to move. + -> Int -- ^ @position@ - the new position to place @child@. Positions are + -- numbered from 0 to n-1. + -> IO () +menuReorderChild self child position = + {# call menu_reorder_child #} + (toMenu self) + (toWidget child) + (fromIntegral position) -- | Popup a context menu where a button press occurred. -- -- -menuPopup :: MenuClass m => m -> Event -> IO () -menuPopup m (Events.Button { time=t, button=b }) = {#call menu_popup#} - (toMenu m) (mkWidget nullForeignPtr) (mkWidget nullForeignPtr) nullFunPtr - nullPtr ((fromIntegral.fromEnum) b) (fromIntegral t) +menuPopup :: MenuClass self => self -> Event -> IO () +menuPopup self (Events.Button { time=t, button=b }) = + {# call menu_popup #} + (toMenu self) + (mkWidget nullForeignPtr) + (mkWidget nullForeignPtr) + nullFunPtr + nullPtr + ((fromIntegral . fromEnum) b) + (fromIntegral t) menuPopup _ _ = error "menuPopup: Button event expected." --- | Set the "AccelGroup" which holds global accelerators for the menu. This +-- | Set the 'AccelGroup' which holds global accelerators for the menu. This -- accelerator group needs to also be added to all windows that this menu is -- being used in with 'windowAddAccelGroup', in order for those windows to -- support all the accelerators contained in this group. -- -menuSetAccelGroup :: MenuClass m => m -> AccelGroup -> IO () -menuSetAccelGroup m accel = - {#call menu_set_accel_group#} (toMenu m) accel +menuSetAccelGroup :: MenuClass self => self + -> AccelGroup -- ^ @accelGroup@ - the 'AccelGroup' to be associated with the + -- menu. + -> IO () +menuSetAccelGroup self accelGroup = + {# call menu_set_accel_group #} + (toMenu self) + accelGroup --- | Gets the "AccelGroup" which holds global accelerators for the menu. See +-- | Gets the 'AccelGroup' which holds global accelerators for the menu. See -- 'menuSetAccelGroup'. -- -menuGetAccelGroup :: MenuClass m => m -> IO AccelGroup -menuGetAccelGroup m = +menuGetAccelGroup :: MenuClass self => self + -> IO AccelGroup -- ^ returns the 'AccelGroup' associated with the menu. +menuGetAccelGroup self = makeNewGObject mkAccelGroup $ - {#call unsafe menu_get_accel_group#} (toMenu m) + {# call unsafe menu_get_accel_group #} + (toMenu self) --- | Sets an accelerator path for this menu from which accelerator paths for its --- immediate children, its menu items, can be constructed. The main purpose of --- this function is to spare the programmer the inconvenience of having to call --- 'menuItemSetAccelPath' on each menu item that should support runtime user --- changable accelerators. Instead, by just calling 'menuSetAccelPath' on their --- parent, each menu item of this menu, that contains a label describing its --- purpose, automatically gets an accel path assigned. +-- | Sets an accelerator path for this menu from which accelerator paths for +-- its immediate children, its menu items, can be constructed. The main purpose +-- of this function is to spare the programmer the inconvenience of having to +-- call 'menuItemSetAccelPath' on each menu item that should support runtime +-- user changable accelerators. Instead, by just calling 'menuSetAccelPath' on +-- their parent, each menu item of this menu, that contains a label describing +-- its purpose, automatically gets an accel path assigned. -- -- For example, a menu containing menu items \"New\" and \"Exit\", will, after -- calling -- -- > menu `menuSetAccelPath` "<Gnumeric-Sheet>/File" -- --- assign its items the accel paths: \"<Gnumeric-Sheet>\/File\/New\" and --- \"<Gnumeric-Sheet>\/File\/Exit\". +-- assign its items the accel paths: @\"\<Gnumeric-Sheet\>\/File\/New\"@ and +-- @\"\<Gnumeric-Sheet\>\/File\/Exit\"@. -- -- Assigning accel paths to menu items then enables the user to change their -- accelerators at runtime. More details about accelerator paths and their -- default setups can be found at 'accelMapAddEntry'. -- -menuSetAccelPath :: MenuClass m => m -> String -> IO () -menuSetAccelPath m accelPath = - withUTFString accelPath $ \strPtr -> - {#call menu_set_accel_path#} (toMenu m) strPtr +menuSetAccelPath :: MenuClass self => self + -> String -- ^ @accelPath@ - a valid accelerator path + -> IO () +menuSetAccelPath self accelPath = + withUTFString accelPath $ \accelPathPtr -> + {# call menu_set_accel_path #} + (toMenu self) + accelPathPtr --- | Set the title of the menu. It is displayed if the menu is shown as a --- tearoff menu. +-- | Sets the title string for the menu. The title is displayed when the menu +-- is shown as a tearoff menu. -- -menuSetTitle :: MenuClass m => m -> String -> IO () -menuSetTitle m title = withUTFString title $ \strPtr -> - {#call unsafe menu_set_title#} (toMenu m) strPtr +menuSetTitle :: MenuClass self => self -> String -> IO () +menuSetTitle self title = + withUTFString title $ \titlePtr -> + {# call unsafe menu_set_title #} + (toMenu self) + titlePtr --- | Returns the title of the menu, orNothing if the menu has no title set on --- it. +-- | Returns the title of the menu. See 'menuSetTitle'. -- -menuGetTitle :: MenuClass m => m -> IO (Maybe String) -menuGetTitle m = - {#call unsafe menu_get_title#} (toMenu m) >>= maybePeek peekUTFString +menuGetTitle :: MenuClass self => self + -> IO (Maybe String) -- ^ returns the title of the menu, or @Nothing@ if the + -- menu has no title set on it. +menuGetTitle self = + {# call unsafe menu_get_title #} + (toMenu self) + >>= maybePeek peekUTFString --- | Remove a context or tearoff menu from the screen. +-- | Removes the menu from the screen. -- -menuPopdown :: MenuClass m => m -> IO () -menuPopdown m = {#call menu_popdown#} (toMenu m) +menuPopdown :: MenuClass self => self -> IO () +menuPopdown self = + {# call menu_popdown #} + (toMenu self) -- | Repositions the menu according to its position function. -- -menuReposition :: MenuClass m => m -> IO () -menuReposition m = {#call menu_reposition#} (toMenu m) +menuReposition :: MenuClass self => self -> IO () +menuReposition self = + {# call menu_reposition #} + (toMenu self) --- | Return the currently selected menu item. +-- | Returns the selected menu item from the menu. This is used by the +-- 'OptionMenu'. -- -menuGetActive :: MenuClass m => m -> IO MenuItem -menuGetActive m = makeNewObject mkMenuItem $ +menuGetActive :: MenuClass self => self + -> IO MenuItem -- ^ returns the 'MenuItem' that was last selected in the menu. + -- If a selection has not yet been made, the first menu item is + -- selected. +menuGetActive self = + makeNewObject mkMenuItem $ throwIfNull "menuGetActive: menu contains no menu items." $ - liftM castPtr $ {#call menu_get_active#} (toMenu m) + liftM castPtr $ + {# call menu_get_active #} + (toMenu self) --- | Select the @n@th item of the menu. +-- | Selects the specified menu item within the menu. This is used by the +-- 'OptionMenu' and should not be used by anyone else. -- -menuSetActive :: MenuClass m => m -> Int -> IO () -menuSetActive m n = {#call menu_set_active#} (toMenu m) (fromIntegral n) +menuSetActive :: MenuClass self => self + -> Int -- ^ @index@ - the index of the menu item to select. Index values + -- are from 0 to n-1. + -> IO () +menuSetActive self index = + {# call menu_set_active #} + (toMenu self) + (fromIntegral index) --- | Specify whether the menu is to be shown as a tearoff menu. +-- | Changes the tearoff state of the menu. A menu is normally displayed as +-- drop down menu which persists as long as the menu is active. It can also be +-- displayed as a tearoff menu which persists until it is closed or reattached. -- -menuSetTearoffState :: MenuClass m => m -> Bool -> IO () -menuSetTearoffState m tornOff = - {#call menu_set_tearoff_state#} (toMenu m) (fromBool tornOff) +menuSetTearoffState :: MenuClass self => self + -> Bool -- ^ @tornOff@ - If @True@, menu is displayed as a tearoff menu. + -> IO () +menuSetTearoffState self tornOff = + {# call menu_set_tearoff_state #} + (toMenu self) + (fromBool tornOff) --- | Returns whether the menu is torn off. +-- | Returns whether the menu is torn off. See 'menuSetTearoffState'. -- -menuGetTearoffState :: MenuClass m => m -> IO Bool -menuGetTearoffState m = liftM toBool $ - {#call unsafe menu_get_tearoff_state#} (toMenu m) +menuGetTearoffState :: MenuClass self => self + -> IO Bool -- ^ returns @True@ if the menu is currently torn off. +menuGetTearoffState self = + liftM toBool $ + {# call unsafe menu_get_tearoff_state #} + (toMenu self) -- | Attach this menu to another widget. -- -menuAttachToWidget :: (MenuClass m, WidgetClass w) => m -> w -> IO () -menuAttachToWidget m w = - {#call menu_attach_to_widget#} (toMenu m) (toWidget w) nullFunPtr +menuAttachToWidget :: (MenuClass self, WidgetClass w) => self -> w -> IO () +menuAttachToWidget self w = + {# call menu_attach_to_widget #} + (toMenu self) + (toWidget w) + nullFunPtr -- | Detach this menu from the widget it is attached to. -- -menuDetach :: MenuClass m => m -> IO () -menuDetach m = {#call menu_detach#} (toMenu m) +menuDetach :: MenuClass self => self -> IO () +menuDetach self = + {# call menu_detach #} + (toMenu self) -- | Get the widget this menu is attached to. Returns Nothing if this is a -- tearoff (context) menu. -- -menuGetAttachWidget :: MenuClass m => m -> IO (Maybe Widget) -menuGetAttachWidget m = do - wPtr <- {#call unsafe menu_get_attach_widget#} (toMenu m) +menuGetAttachWidget :: MenuClass self => self -> IO (Maybe Widget) +menuGetAttachWidget self = do + wPtr <- {#call unsafe menu_get_attach_widget#} (toMenu self) if wPtr==nullPtr then return Nothing else liftM Just $ makeNewObject mkWidget (return wPtr) #if GTK_CHECK_VERSION(2,2,0) --- | Sets the "Screen" on which the menu will be displayed. +-- | Sets the 'Screen' on which the menu will be displayed. -- -menuSetScreen :: MenuClass m => m -> Maybe Screen -> IO () -menuSetScreen m screen = - {#call menu_set_screen#} (toMenu m) +-- * Available since Gtk version 2.2 +-- +menuSetScreen :: MenuClass self => self + -> Maybe Screen -- ^ @screen@ - a 'Screen', or @Nothing@ if the screen should + -- be determined by the widget the menu is attached to. + -> IO () +menuSetScreen self screen = + {# call menu_set_screen #} + (toMenu self) (fromMaybe (Screen nullForeignPtr) screen) - #endif + #if GTK_CHECK_VERSION(2,4,0) --- | Informs GTK+ on which monitor a menu should be popped up. +-- | Informs Gtk+ on which monitor a menu should be popped up. See +-- 'screenGetMonitorGeometry'. -- -menuSetMonitor :: MenuClass m => m - -> Int -- ^ The number of the monitor on which the menu - -- should be popped up - -> IO () -menuSetMonitor m monitorNum = - {#call menu_set_monitor#} (toMenu m) (fromIntegral monitorNum) +-- * Available since Gtk version 2.4 +-- +menuSetMonitor :: MenuClass self => self + -> Int -- ^ @monitorNum@ - the number of the monitor on which the menu + -- should be popped up + -> IO () +menuSetMonitor self monitorNum = + {# call menu_set_monitor #} + (toMenu self) + (fromIntegral monitorNum) #endif -------------------- @@ -280,14 +351,14 @@ -- | -- -menuTearoffState :: Attr Menu Bool +menuTearoffState :: MenuClass self => Attr self Bool menuTearoffState = Attr menuGetTearoffState menuSetTearoffState -- | \'accelGroup\' property. See 'menuGetAccelGroup' and 'menuSetAccelGroup' -- -menuAccelGroup :: Attr Menu AccelGroup +menuAccelGroup :: MenuClass self => Attr self AccelGroup menuAccelGroup = Attr menuGetAccelGroup menuSetAccelGroup Index: ToolItem.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/MenuComboToolbar/ToolItem.chs.pp,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- ToolItem.chs.pp 13 Mar 2005 19:34:35 -0000 1.4 +++ ToolItem.chs.pp 2 Apr 2005 16:52:50 -0000 1.5 @@ -24,10 +24,12 @@ -- Stability : provisional -- Portability : portable (depends on GHC) -- --- 'ToolItem' is the base class of widgets that can be added to 'Toolbar'. +-- The base class of widgets that can be added to 'Toolbar' +-- +-- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.MenuComboToolbar.ToolItem ( --- * Description +-- * Detail -- -- | 'ToolItem's are widgets that can appear on a toolbar. To create a toolbar -- item that contain something else than a button, use 'toolItemNew'. Use @@ -35,8 +37,6 @@ -- -- For toolbar items that contain buttons, see the 'ToolButton', -- 'ToggleToolButton' and 'RadioToolButton' classes. --- --- * Module available since Gtk version 2.4 -- * Class Hierarchy -- | @@ -96,8 +96,6 @@ #endif ) where -#if GTK_CHECK_VERSION(2,4,0) - import Monad (liftM) import System.Glib.FFI @@ -111,14 +109,16 @@ {# context lib="gtk" prefix="gtk" #} +#if GTK_CHECK_VERSION(2,4,0) -------------------- -- Constructors --- | Creates a new "ToolItem". +-- | Creates a new 'ToolItem' -- toolItemNew :: IO ToolItem toolItemNew = - makeNewObject mkToolItem {#call unsafe tool_item_new#} + makeNewObject mkToolItem $ + {# call unsafe tool_item_new #} -------------------- -- Methods @@ -127,162 +127,220 @@ -- homogeneous items. The effect is that all homogeneous items will have the -- same width as the widest of the items. -- -toolItemSetHomogeneous :: ToolItemClass item => item -> Bool -> IO () -toolItemSetHomogeneous item homogeneous = - {#call tool_item_set_homogeneous#} (toToolItem item) (fromBool homogeneous) +toolItemSetHomogeneous :: ToolItemClass self => self + -> Bool -- ^ @homogeneous@ - whether @toolItem@ is the same size as other + -- homogeneous items + -> IO () +toolItemSetHomogeneous self homogeneous = + {# call tool_item_set_homogeneous #} + (toToolItem self) + (fromBool homogeneous) -- | Returns whether the tool item is the same size as other homogeneous items. +-- See 'toolItemSetHomogeneous'. -- -toolItemGetHomogeneous :: ToolItemClass item => item -> IO Bool -toolItemGetHomogeneous item = liftM toBool $ - {#call unsafe tool_item_get_homogeneous#} (toToolItem item) +toolItemGetHomogeneous :: ToolItemClass self => self -> IO Bool +toolItemGetHomogeneous self = + liftM toBool $ + {# call unsafe tool_item_get_homogeneous #} + (toToolItem self) -- | Sets whether the tool item is allocated extra space when there is more room -- on the toolbar then needed for the items. The effect is that the item gets -- bigger when the toolbar gets bigger and smaller when the toolbar gets -- smaller. -- -toolItemSetExpand :: ToolItemClass item => item -> Bool -> IO () -toolItemSetExpand item expand = - {#call tool_item_set_expand#} (toToolItem item) (fromBool expand) +toolItemSetExpand :: ToolItemClass self => self -> Bool -> IO () +toolItemSetExpand self expand = + {# call tool_item_set_expand #} + (toToolItem self) + (fromBool expand) --- | Returns whether the tool item is allocated extra space. +-- | Returns whether the tool item is allocated extra space. See +-- 'toolItemSetExpand'. -- -toolItemGetExpand :: ToolItemClass item => item -> IO Bool -toolItemGetExpand item = liftM toBool $ - {#call unsafe tool_item_get_expand#} (toToolItem item) +toolItemGetExpand :: ToolItemClass self => self -> IO Bool +toolItemGetExpand self = + liftM toBool $ + {# call unsafe tool_item_get_expand #} + (toToolItem self) --- | Sets the "Tooltips" object to be used for the tool item, the text to be +-- | Sets the 'Tooltips' object to be used for the tool item, the text to be -- displayed as tooltip on the item and the private text to be used. See -- 'tooltipsSetTip'. -- -toolItemSetTooltip :: ToolItemClass item => item -> Tooltips - -> String -- ^ - -> String -- ^ - -> IO () -toolItemSetTooltip item tips text private = - withUTFString text $ \strPtr1 -> - withUTFString private $ \strPtr2 -> - {#call tool_item_set_tooltip#} (toToolItem item) tips strPtr1 strPtr2 +toolItemSetTooltip :: ToolItemClass self => self + -> Tooltips -- ^ @tooltips@ - The 'Tooltips' object to be used + -> String -- ^ @tipText@ - text to be used as tooltip text for @toolItem@ + -> String -- ^ @tipPrivate@ - text to be used as private tooltip text + -> IO () +toolItemSetTooltip self tooltips tipText tipPrivate = + withUTFString tipPrivate $ \tipPrivatePtr -> + withUTFString tipText $ \tipTextPtr -> + {# call tool_item_set_tooltip #} + (toToolItem self) + tooltips + tipTextPtr + tipPrivatePtr --- | Sets whether toolitem has a drag window. When True the tool item can be +-- | Sets whether toolitem has a drag window. When @True@ the tool item can be -- used as a drag source through 'dragSourceSet'. When the tool item has a drag -- window it will intercept all events, even those that would otherwise be sent -- to a child widget. -- -toolItemSetUseDragWindow :: ToolItemClass item => item -> Bool -> IO () -toolItemSetUseDragWindow item useDragWin = - {#call tool_item_set_use_drag_window#} (toToolItem item) (fromBool useDragWin) +toolItemSetUseDragWindow :: ToolItemClass self => self -> Bool -> IO () +toolItemSetUseDragWindow self useDragWindow = + {# call tool_item_set_use_drag_window #} + (toToolItem self) + (fromBool useDragWindow) -- | Returns whether the tool item has a drag window. See -- 'toolItemSetUseDragWindow'. -- -toolItemGetUseDragWindow :: ToolItemClass item => item -> IO Bool -toolItemGetUseDragWindow item = liftM toBool $ - {#call unsafe tool_item_get_use_drag_window#} (toToolItem item) +toolItemGetUseDragWindow :: ToolItemClass self => self -> IO Bool +toolItemGetUseDragWindow self = + liftM toBool $ + {# call unsafe tool_item_get_use_drag_window #} + (toToolItem self) -- | Sets whether the tool item is visible when the toolbar is docked -- horizontally. -- -toolItemSetVisibleHorizontal :: ToolItemClass item => item -> Bool -> IO () -toolItemSetVisibleHorizontal item visible = - {#call tool_item_set_visible_horizontal#} (toToolItem item) (fromBool visible) +toolItemSetVisibleHorizontal :: ToolItemClass self => self -> Bool -> IO () +toolItemSetVisibleHorizontal self visibleHorizontal = + {# call tool_item_set_visible_horizontal #} + (toToolItem self) + (fromBool visibleHorizontal) -- | Returns whether the tool item is visible on toolbars that are docked -- horizontally. -- -toolItemGetVisibleHorizontal :: ToolItemClass item => item -> IO Bool -toolItemGetVisibleHorizontal item = liftM toBool $ - {#call unsafe tool_item_get_visible_horizontal#} (toToolItem item) +toolItemGetVisibleHorizontal :: ToolItemClass self => self -> IO Bool +toolItemGetVisibleHorizontal self = + liftM toBool $ + {# call unsafe tool_item_get_visible_horizontal #} + (toToolItem self) --- | Sets whether the tool item is visible when the toolbar is docked --- vertically. Some tool items, such as text entries, are too wide to be useful --- on a vertically docked toolbar. If False the tool item will not appear on --- toolbars that are docked vertically. +-- | Sets whether the tool item is visible when the toolbar is docked vertically. +-- Some tool items, such as text entries, are too wide to be useful on a +-- vertically docked toolbar. If @False@ the tool item will +-- not appear on toolbars that are docked vertically. -- -toolItemSetVisibleVertical :: ToolItemClass item => item -> Bool -> IO () -toolItemSetVisibleVertical item visible = - {#call tool_item_set_visible_vertical#} (toToolItem item) (fromBool visible) +toolItemSetVisibleVertical :: ToolItemClass self => self -> Bool -> IO () +toolItemSetVisibleVertical self visibleVertical = + {# call tool_item_set_visible_vertical #} + (toToolItem self) + (fromBool visibleVertical) -- | Returns whether the tool item is visible when the toolbar is docked --- vertically. +-- vertically. See 'toolItemSetVisibleVertical'. -- -toolItemGetVisibleVertical :: ToolItemClass item => item -> IO Bool -toolItemGetVisibleVertical item = liftM toBool $ - {#call unsafe tool_item_get_visible_vertical#} (toToolItem item) +toolItemGetVisibleVertical :: ToolItemClass self => self -> IO Bool +toolItemGetVisibleVertical self = + liftM toBool $ + {# call unsafe tool_item_get_visible_vertical #} + (toToolItem self) -- | Sets whether the tool item should be considered important. The "ToolButton" -- class uses this property to determine whether to show or hide its label when --- the toolbar style is 'ToolbarBothHoriz'. The result is that only tool buttons --- with the \"is important\" property set have labels, an effect known as --- \"priority text\". +-- the toolbar style is 'ToolbarBothHoriz'. The result is that only tool +-- buttons with the \"is important\" property set have labels, an effect known +-- as \"priority text\". -- -toolItemSetIsImportant :: ToolItemClass item => item -> Bool -> IO () -toolItemSetIsImportant item important = - {#call tool_item_set_is_important#} (toToolItem item) (fromBool important) +toolItemSetIsImportant :: ToolItemClass self => self -> Bool -> IO () +toolItemSetIsImportant self isImportant = + {# call tool_item_set_is_important #} + (toToolItem self) + (fromBool isImportant) --- | Returns whether the tool item is considered important. +-- | Returns whether the tool item is considered important. See +-- 'toolItemSetIsImportant' -- -toolItemGetIsImportant :: ToolItemClass item => item -> IO Bool -toolItemGetIsImportant item = liftM toBool $ - {#call unsafe tool_item_get_is_important#} (toToolItem item) +toolItemGetIsImportant :: ToolItemClass self => self -> IO Bool +toolItemGetIsImportant self = + liftM toBool $ + {# call unsafe tool_item_get_is_important #} + (toToolItem self) -- | Returns the icon size used for the tool item. -- -toolItemGetIconSize :: ToolItemClass item => item -> IO IconSize -toolItemGetIconSize item = liftM (toEnum.fromIntegral) $ - {#call unsafe tool_item_get_icon_size#} (toToolItem item) +toolItemGetIconSize :: ToolItemClass self => self -> IO IconSize +toolItemGetIconSize self = + liftM (toEnum . fromIntegral) $ + {# call unsafe tool_item_get_icon_size #} + (toToolItem self) -- | Returns the orientation used for the tool item. -- -toolItemGetOrientation :: ToolItemClass item => item -> IO Orientation -toolItemGetOrientation item = liftM (toEnum.fromIntegral) $ - {#call unsafe tool_item_get_orientation#} (toToolItem item) +toolItemGetOrientation :: ToolItemClass self => self -> IO Orientation +toolItemGetOrientation self = + liftM (toEnum . fromIntegral) $ + {# call unsafe tool_item_get_orientation #} + (toToolItem self) -- | Returns the toolbar style used for the tool item. -- -toolItemGetToolbarStyle :: ToolItemClass item => item -> IO ToolbarStyle -toolItemGetToolbarStyle item = liftM (toEnum.fromIntegral) $ - {#call unsafe tool_item_get_toolbar_style#} (toToolItem item) +-- Possibilities are: +-- ['ToolbarBoth'] meaning the tool item should show both an icon and a label, +-- stacked vertically +-- ['ToolbarIcons'] meaning the toolbar shows only icons +-- ['ToolbarText'] meaning the tool item should only show text +-- ['ToolbarBothHoriz'] meaning the tool item should show both an icon and a +-- label, arranged horizontally +-- +toolItemGetToolbarStyle :: ToolItemClass self => self -> IO ToolbarStyle +toolItemGetToolbarStyle self = + liftM (toEnum . fromIntegral) $ + {# call unsafe tool_item_get_toolbar_style #} + (toToolItem self) -- | Returns the relief style of the tool item. See 'buttonSetReliefStyle'. -- -toolItemGetReliefStyle :: ToolItemClass item => item -> IO ReliefStyle -toolItemGetReliefStyle item = liftM (toEnum.fromIntegral) $ - {#call unsafe tool_item_get_relief_style#} (toToolItem item) +toolItemGetReliefStyle :: ToolItemClass self => self -> IO ReliefStyle +toolItemGetReliefStyle self = + liftM (toEnum . fromIntegral) $ + {# call unsafe tool_item_get_relief_style #} + (toToolItem self) --- | Returns the "MenuItem" that was last set by 'toolItemSetProxyMenuItem', --- ie. the "MenuItem" that is going to appear in the overflow menu. +-- | Returns the 'MenuItem' that was last set by 'toolItemSetProxyMenuItem', +-- ie. the 'MenuItem' that is going to appear in the overflow menu. -- -toolItemRetrieveProxyMenuItem :: ToolItemClass item => item -> IO (Maybe Widget) -toolItemRetrieveProxyMenuItem item = do - wPtr <- {#call unsafe tool_item_retrieve_proxy_menu_item#} (toToolItem item) - if wPtr==nullPtr then return Nothing else liftM Just $ - makeNewObject mkWidget $ return wPtr +toolItemRetrieveProxyMenuItem :: ToolItemClass self => self -> IO (Maybe Widget) +toolItemRetrieveProxyMenuItem self = + maybeNull (makeNewObject mkWidget) $ + {# call unsafe tool_item_retrieve_proxy_menu_item #} + (toToolItem self) --- | If the menu item identifier string matches the string passed to --- 'toolItemSetProxyMenuItem' the returns the corresponding "MenuItem". +-- | If @menuItemId@ matches the string passed to 'toolItemSetProxyMenuItem' +-- return the corresponding 'MenuItem'. -- -toolItemGetProxyMenuItem :: ToolItemClass item => item -> String -> IO (Maybe Widget) -toolItemGetProxyMenuItem item itemId = - withCString itemId $ \strPtr -> do - wPtr <- {#call unsafe tool_item_get_proxy_menu_item#} (toToolItem item) strPtr - if wPtr==nullPtr then return Nothing else liftM Just $ - makeNewObject mkWidget $ return wPtr +toolItemGetProxyMenuItem :: ToolItemClass self => self + -> String -- ^ @menuItemId@ - a string used to identify the menu + -- item + -> IO (Maybe Widget) -- ^ returns The 'MenuItem' passed to + -- 'toolItemSetProxyMenuItem', if the @menuItemId@s + -- match. +toolItemGetProxyMenuItem self menuItemId = + maybeNull (makeNewObject mkWidget) $ + withCString menuItemId $ \menuItemIdPtr -> + {# call unsafe tool_item_get_proxy_menu_item #} + (toToolItem self) + menuItemIdPtr --- | Sets the "MenuItem" used in the toolbar overflow menu. The menu item identifier +-- | Sets the 'MenuItem' used in the toolbar overflow menu. The @menuItemId@ -- is used to identify the caller of this function and should also be used with -- 'toolItemGetProxyMenuItem'. -- -toolItemSetProxyMenuItem :: (ToolItemClass item, MenuItemClass menuItem) => item - -> String -- ^ Menu item identifier string - -> menuItem -- ^ A "MenuItem" to be used in the - -- overflow menu - -> IO () -toolItemSetProxyMenuItem item menuItemId menuItem = - withCString menuItemId $ \strPtr -> - {#call tool_item_set_proxy_menu_item#} (toToolItem item) - strPtr (toWidget menuItem) +toolItemSetProxyMenuItem :: (ToolItemClass self, MenuItemClass menuItem) => self + -> String -- ^ @menuItemId@ - a string used to identify @menuItem@ + -> menuItem -- ^ @menuItem@ - a 'MenuItem' to be used in the overflow menu + -> IO () +toolItemSetProxyMenuItem self menuItemId menuItem = + withCString menuItemId $ \menuItemIdPtr -> + {# call tool_item_set_proxy_menu_item #} + (toToolItem self) + menuItemIdPtr + (toWidget menuItem) -------------------- -- Properties @@ -292,7 +350,7 @@ -- -- Default value: @True@ -- -toolItemVisibleHorizontal :: Attr ToolItem Bool +toolItemVisibleHorizontal :: ToolItemClass self => Attr self Bool toolItemVisibleHorizontal = Attr toolItemGetVisibleHorizontal toolItemSetVisibleHorizontal @@ -302,7 +360,7 @@ -- -- Default value: @True@ -- -toolItemVisibleVertical :: Attr ToolItem Bool +toolItemVisibleVertical :: ToolItemClass self => Attr self Bool toolItemVisibleVertical = Attr toolItemGetVisibleVertical toolItemSetVisibleVertical @@ -312,14 +370,14 @@ -- -- Default value: @False@ -- -toolItemIsImportant :: Attr ToolItem Bool +toolItemIsImportant :: ToolItemClass self => Attr self Bool toolItemIsImportant = Attr toolItemGetIsImportant toolItemSetIsImportant -- | \'expand\' property. See 'toolItemGetExpand' and 'toolItemSetExpand' -- -toolItemExpand :: Attr ToolItem Bool +toolItemExpand :: ToolItemClass self => Attr self Bool toolItemExpand = Attr toolItemGetExpand toolItemSetExpand @@ -327,7 +385,7 @@ -- | \'homogeneous\' property. See 'toolItemGetHomogeneous' and -- 'toolItemSetHomogeneous' -- -toolItemHomogeneous :: Attr ToolItem Bool +toolItemHomogeneous :: ToolItemClass self => Attr self Bool toolItemHomogeneous = Attr toolItemGetHomogeneous toolItemSetHomogeneous @@ -335,7 +393,7 @@ -- | \'useDragWindow\' property. See 'toolItemGetUseDragWindow' and -- 'toolItemSetUseDragWindow' -- -toolItemUseDragWindow :: Attr ToolItem Bool +toolItemUseDragWindow :: ToolItemClass self => Attr self Bool toolItemUseDragWindow = Attr toolItemGetUseDragWindow toolItemSetUseDragWindow Index: RadioMenuItem.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/MenuComboToolbar/RadioMenuItem.chs,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- RadioMenuItem.chs 25 Feb 2005 01:11:35 -0000 1.3 +++ RadioMenuItem.chs 2 Apr 2005 16:52:50 -0000 1.4 @@ -19,19 +19,19 @@ -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details. -- +-- Note: These are not the original Gtk functions as they involve handling a +-- Gtk owned GList. The interface is rather oriented towards the RadioButton +-- widget interface. +-- -- | -- Maintainer : gtk...@li... -- Stability : provisional -- Portability : portable (depends on GHC) -- --- A choice from multiple check menu items. --- --- * These are not the original Gtk functions as they involve handling a Gtk --- owned GList. The interface is rather oriented towards the RadioButton --- widget interface. +-- A choice from multiple check menu items -- module Graphics.UI.Gtk.MenuComboToolbar.RadioMenuItem ( --- * Description +-- * Detail -- -- | A radio menu item is a check menu item that belongs to a group. At each -- instant exactly one of the radio menu items from a group is selected. @@ -82,41 +82,54 @@ -------------------- -- Constructors --- | Create a new radio menu item. +-- | Creates a new 'RadioMenuItem'. -- radioMenuItemNew :: IO RadioMenuItem -radioMenuItemNew = makeNewObject mkRadioMenuItem $ liftM castPtr $ - {#call unsafe radio_menu_item_new#} nullPtr +radioMenuItemNew = + makeNewObject mkRadioMenuItem $ + liftM (castPtr :: Ptr Widget -> Ptr RadioMenuItem) $ + {# call unsafe radio_menu_item_new #} + nullPtr --- | Create a new radio menu item with a label in it. +-- | Creates a new 'RadioMenuItem' whose child is a simple 'Label'. -- radioMenuItemNewWithLabel :: String -> IO RadioMenuItem -radioMenuItemNewWithLabel label = withUTFString label $ \strPtr -> - makeNewObject mkRadioMenuItem $ liftM castPtr $ - {#call unsafe radio_menu_item_new_with_label#} nullPtr strPtr +radioMenuItemNewWithLabel label = + makeNewObject mkRadioMenuItem $ + liftM (castPtr :: Ptr Widget -> Ptr RadioMenuItem) $ + withUTFString label $ \labelPtr -> + {# call unsafe radio_menu_item_new_with_label #} + nullPtr + labelPtr --- | Create a new radio menu item with a label in it. Underscores in the label --- string indicate the mnemonic for the menu item. +-- | Creates a new 'RadioMenuItem' containing a label. The label will be +-- created using 'labelNewWithMnemonic', so underscores in @label@ indicate the +-- mnemonic for the menu item. -- radioMenuItemNewWithMnemonic :: String -> IO RadioMenuItem -radioMenuItemNewWithMnemonic label = withUTFString label $ \strPtr -> - makeNewObject mkRadioMenuItem $ liftM castPtr $ - {#call unsafe radio_menu_item_new_with_mnemonic#} nullPtr strPtr +radioMenuItemNewWithMnemonic label = + makeNewObject mkRadioMenuItem $ + liftM (castPtr :: Ptr Widget -> Ptr RadioMenuItem) $ + withUTFString label $ \labelPtr -> + {# call unsafe radio_menu_item_new_with_mnemonic #} + nullPtr + labelPtr -- | Create a new radio button and attach it to the group of another radio -- button. -- radioMenuItemNewJoinGroup :: RadioMenuItem -> IO RadioMenuItem radioMenuItemNewJoinGroup rmi = do - groupPtr <- {#call unsafe radio_menu_item_get_group#} rmi + groupPtr <- {# call unsafe radio_menu_item_get_group #} rmi makeNewObject mkRadioMenuItem $ liftM castPtr $ {#call unsafe radio_menu_item_new#} groupPtr -- | Create a new radio button with a label and attach it to the group of -- another radio button. -- -radioMenuItemNewJoinGroupWithLabel :: RadioMenuItem -> String -> - IO RadioMenuItem +radioMenuItemNewJoinGroupWithLabel :: RadioMenuItem + -> String + -> IO RadioMenuItem radioMenuItemNewJoinGroupWithLabel rmi label = do groupPtr <- {#call unsafe radio_menu_item_get_group#} rmi withUTFString label $ \strPtr -> @@ -127,8 +140,9 @@ -- another radio button. Underscores in the label string indicate the mnemonic -- for the menu item. -- -radioMenuItemNewJoinGroupWithMnemonic :: RadioMenuItem -> String -> - IO RadioMenuItem +radioMenuItemNewJoinGroupWithMnemonic :: RadioMenuItem + -> String + -> IO RadioMenuItem radioMenuItemNewJoinGroupWithMnemonic rmi label = do groupPtr <- {#call unsafe radio_menu_item_get_group#} rmi withUTFString label $ \strPtr -> Index: MenuBar.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuBar.chs,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- MenuBar.chs 25 Feb 2005 01:11:35 -0000 1.3 +++ MenuBar.chs 2 Apr 2005 16:52:50 -0000 1.4 @@ -27,7 +27,7 @@ -- A subclass widget for 'MenuShell' which holds 'MenuItem' widgets -- module Graphics.UI.Gtk.MenuComboToolbar.MenuBar ( --- * Description +-- * Detail -- -- | The 'MenuBar' is a subclass of 'MenuShell' which contains one to many -- 'MenuItem'. The result is a standard menu bar which can hold many menu @@ -66,8 +66,10 @@ -------------------- -- Constructors --- | Create a horizontal bar that contains menu items. +-- | Creates the new 'MenuBar' -- menuBarNew :: IO MenuBar -menuBarNew = makeNewObject mkMenuBar $ - liftM castPtr {#call unsafe menu_bar_new#} +menuBarNew = + makeNewObject mkMenuBar $ + liftM (castPtr :: Ptr Widget -> Ptr MenuBar) $ + {# call unsafe menu_bar_new #} Index: Combo.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/MenuComboToolbar/Combo.chs.pp,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Combo.chs.pp 25 Feb 2005 22:53:41 -0000 1.4 +++ Combo.chs.pp 2 Apr 2005 16:52:49 -0000 1.5 @@ -29,10 +29,13 @@ -- Stability : provisional -- Portability : portable (depends on GHC) -- --- A Combo is a text entry field with a dropdown list. +-- A text entry field with a dropdown list +-- +-- * Warning: this module is deprecated and should not be used in +-- newly-written code. -- module Graphics.UI.Gtk.MenuComboToolbar.Combo ( --- * Description +-- * Detail -- -- | The 'Combo' widget consists of a single-line text entry field and a -- drop-down list. The drop-down list is displayed when the user clicks on a @@ -60,11 +63,14 @@ -- | +----'HBox' -- | +----Combo -- @ + #ifndef DISABLE_DEPRECATED -- * Types Combo, ComboClass, castToCombo, + +-- * Constructors comboNew, -- * Methods @@ -76,7 +82,6 @@ comboDisableActivate #endif ) where -#ifndef DISABLE_DEPRECATED import Monad (liftM, mapM_) @@ -91,20 +96,27 @@ {# context lib="gtk" prefix="gtk" #} +#ifndef DISABLE_DEPRECATED -------------------- --- Methods +-- Constructors -- Create a new Combo text entry field. -- comboNew :: IO Combo -comboNew = makeNewObject mkCombo $ liftM castPtr $ {#call unsafe combo_new#} +comboNew = + makeNewObject mkCombo $ + liftM castPtr $ + {# call unsafe combo_new #} + +-------------------- +-- Methods -- | Insert a set of Strings into the -- 'Combo' drop down list. -- -comboSetPopdownStrings :: ComboClass c => c -> [String] -> IO () -comboSetPopdownStrings c strs = do - list <- comboGetList (toCombo c) +comboSetPopdownStrings :: ComboClass self => self -> [String] -> IO () +comboSetPopdownStrings self strs = do + list <- comboGetList (toCombo self) {#call list_clear_items#} list 0 (-1) mapM_ (\str -> do li <- makeNewObject mkWidget $ liftM castPtr $ @@ -113,42 +125,62 @@ containerAdd list li) strs --- | Specify whether the user may enter texts that --- are not in the list of alternatives and if empty entries are allowed. +-- | Specifies whether the value entered in the text entry field must match +-- one of the values in the list. If this is set then the user will not be able +-- to perform any other action until a valid value has been entered. -- -comboSetValueInList :: ComboClass c => c -> Bool -> Bool -> IO () -comboSetValueInList c val okIfEmpty = {#call unsafe combo_set_value_in_list#} - (toCombo c) (fromBool val) (fromBool okIfEmpty) +-- If an empty field is acceptable, the @okIfEmpty@ parameter should be +-- @True@. +-- +comboSetValueInList :: ComboClass self => self + -> Bool -- ^ @val@ - @True@ if the value entered must match one of the + -- values in the list. + -> Bool -- ^ @okIfEmpty@ - @True@ if an empty value is considered valid. + -> IO () +comboSetValueInList self val okIfEmpty = + {# call unsafe combo_set_value_in_list #} + (toCombo self) + (fromBool val) + (fromBool okIfEmpty) --- | Specify if the user may use the cursor keys to --- navigate the list. +-- | Specifies if the arrow (cursor) keys can be used to step through the +-- items in the list. This is on by default. -- -comboSetUseArrows :: ComboClass c => c -> Bool -> IO () -comboSetUseArrows c val = {#call unsafe combo_set_use_arrows#} (toCombo c) - (fromBool val) +comboSetUseArrows :: ComboClass self => self -> Bool -> IO () +comboSetUseArrows self val = + {# call unsafe combo_set_use_arrows #} + (toCombo self) + (fromBool val) --- | Specify if the content entered by the user --- will be replaced by a predefined alternative as soon as the user uses the --- cursor keys. +-- | Obsolete function, does nothing. -- -comboSetUseArrowsAlways :: ComboClass c => c -> Bool -> IO () -comboSetUseArrowsAlways c val = {#call unsafe combo_set_use_arrows_always#} - (toCombo c) (fromBool val) +comboSetUseArrowsAlways :: ComboClass self => self -> Bool -> IO () +comboSetUseArrowsAlways self val = + {# call unsafe combo_set_use_arrows_always #} + (toCombo self) + (fromBool val) --- | Specify whether the entered text is case --- sensitive when it comes to matching the users input with the predefined --- alternatives. +-- | Specifies whether the text entered into the 'Entry' field and the text in +-- the list items is case sensitive. -- -comboSetCaseSensitive :: ComboClass c => c -> Bool -> IO () -comboSetCaseSensitive c val = {#call unsafe combo_set_case_sensitive#} - (toCombo c) (fromBool val) +-- This may be useful, for example, when you have called +-- 'comboSetValueInList' to limit the values entered, but you are not worried +-- about differences in case. +-- +comboSetCaseSensitive :: ComboClass self => self -> Bool -> IO () +comboSetCaseSensitive self val = + {# call unsafe combo_set_case_sensitive #} + (toCombo self) + (fromBool val) --- | Stops the GtkCombo widget from showing the --- popup list when the Entry emits the \"activate\" signal, i.e. when the Return --- key is pressed. This may be useful if, for example, if you want the Return --- key to close a dialog instead. +-- | Stops the 'Combo' widget from showing the popup list when the 'Entry' +-- emits the \"activate\" signal, i.e. when the Return key is pressed. This may +-- be useful if, for example, you want the Return key to close a dialog +-- instead. -- -comboDisableActivate :: ComboClass c => c -> IO () -comboDisableActivate = {#call unsafe combo_disable_activate#}.toCombo +comboDisableActivate :: ComboClass self => self -> IO () +comboDisableActivate self = + {# call unsafe combo_disable_activate #} + (toCombo self) #endif Index: CheckMenuItem.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/MenuComboToolbar/CheckMenuItem.chs.pp,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- CheckMenuItem.chs.pp 13 Mar 2005 19:34:34 -0000 1.5 +++ CheckMenuItem.chs.pp 2 Apr 2005 16:52:49 -0000 1.6 @@ -24,10 +24,10 @@ -- Stability : provisional -- Portability : portable (depends on GHC) -- --- This widget implements a 'MenuItem' with a check next to it. +-- A menu item with a check box -- module Graphics.UI.Gtk.MenuComboToolbar.CheckMenuItem ( --- * Description +-- * Detail -- -- | A 'CheckMenuItem' is a menu item that maintains the state of a boolean -- value in addition to a 'MenuItem''s usual role in activating application @@ -91,75 +91,112 @@ -------------------- -- Constructors --- | Create a new 'MenuItem' with a check next to it. +-- | Creates a new 'CheckMenuItem'. -- checkMenuItemNew :: IO CheckMenuItem -checkMenuItemNew = makeNewObject mkCheckMenuItem $ liftM castPtr $ - {#call unsafe check_menu_item_new#} +checkMenuItemNew = + makeNewObject mkCheckMenuItem $ + liftM (castPtr :: Ptr Widget -> Ptr CheckMenuItem) $ + {# call unsafe check_menu_item_new #} --- | Create a new 'CheckMenuItem' with a 'Label' inside. +-- | Creates a new 'CheckMenuItem' with a label. -- -checkMenuItemNewWithLabel :: String -> IO CheckMenuItem -checkMenuItemNewWithLabel str = withUTFString str $ \strPtr -> - makeNewObject mkCheckMenuItem $ liftM castPtr $ - {#call unsafe check_menu_item_new_with_label#} strPtr +checkMenuItemNewWithLabel :: + String -- ^ @label@ - the string to use for the label. + -> IO CheckMenuItem +checkMenuItemNewWithLabel label = + makeNewObject mkCheckMenuItem $ + liftM (castPtr :: Ptr Widget -> Ptr CheckMenuItem) $ + withUTFString label $ \labelPtr -> + {# call unsafe check_menu_item_new_with_label #} + labelPtr --- | Create a new 'CheckMenuItem' with a 'Label' inside. Underscores in the --- label string indicate the mnemonic for the menu item. +-- | Creates a new 'CheckMenuItem' containing a label. The label will be +-- created using 'labelNewWithMnemonic', so underscores in @label@ indicate the +-- mnemonic for the menu item. -- -checkMenuItemNewWithMnemonic :: String -> IO CheckMenuItem -checkMenuItemNewWithMnemonic str = - withUTFString str $ \strPtr -> - makeNewObject mkCheckMenuItem $ liftM castPtr $ - {#call unsafe check_menu_item_new_with_mnemonic#} strPtr +checkMenuItemNewWithMnemonic :: + String -- ^ @label@ - The text of the button, with an underscore + -- in front of the mnemonic character + -> IO CheckMenuItem +checkMenuItemNewWithMnemonic label = + makeNewObject mkCheckMenuItem $ + liftM (castPtr :: Ptr Widget -> Ptr CheckMenuItem) $ + withUTFString label $ \labelPtr -> + {# call unsafe check_menu_item_new_with_mnemonic #} + labelPtr -------------------- -- Methods -- | Sets the active state of the menu item's check box. -- -checkMenuItemSetActive :: CheckMenuItemClass mi => mi -> Bool -> IO () -checkMenuItemSetActive mi active = {#call check_menu_item_set_active#} - (toCheckMenuItem mi) (fromBool active) +checkMenuItemSetActive :: CheckMenuItemClass self => self -> Bool -> IO () +checkMenuItemSetActive self isActive = + {# call check_menu_item_set_active #} + (toCheckMenuItem self) + (fromBool isActive) --- | Returns whether the check menu item is active. +-- | Returns whether the check menu item is active. See +-- 'checkMenuItemSetActive'. -- -checkMenuItemGetActive :: CheckMenuItemClass mi => mi -> IO Bool -checkMenuItemGetActive mi = - liftM toBool $ {#call unsafe check_menu_item_get_active#} (toCheckMenuItem mi) +checkMenuItemGetActive :: CheckMenuItemClass self => self -> IO Bool +checkMenuItemGetActive self = + liftM toBool $ + {# call unsafe check_menu_item_get_active #} + (toCheckMenuItem self) -- | Emits the toggled signal. -- -checkMenuItemToggled :: CheckMenuItemClass mi => mi -> IO () -checkMenuItemToggled mi = - {#call check_menu_item_toggled#} (toCheckMenuItem mi) +checkMenuItemToggled :: CheckMenuItemClass self => self -> IO () +checkMenuItemToggled self = + {# call check_menu_item_toggled #} + (toCheckMenuItem self) --- | Set the state of the menu item check to \`inconsistent'. +-- | If the user has selected a range of elements (such as some text or +-- spreadsheet cells) that are affected by a boolean setting, and the current +-- values in that range are inconsistent, you may want to display the check in +-- an \"in between\" state. This function turns on \"in between\" display. +-- Normally you would turn off the inconsistent state again if the user +-- explicitly selects a setting. This has to be done manually, +-- 'checkMenuItemSetInconsistent' only affects visual appearance, it doesn't +-- affect the semantics of the widget. -- -checkMenuItemSetInconsistent :: CheckMenuItemClass mi => mi -> Bool -> IO () -checkMenuItemSetInconsistent mi inconsistent = - {#call check_menu_item_set_inconsistent#} (toCheckMenuItem mi) - (fromBool inconsistent) +checkMenuItemSetInconsistent :: CheckMenuItemClass self => self -> Bool -> IO () +checkMenuItemSetInconsistent self setting = + {# call check_menu_item_set_inconsistent #} + (toCheckMenuItem self) + (fromBool setting) --- | Query if the menu check is inconsistent (inbetween). +-- | Query if the menu check is drawn as inconsistent (inbetween). See +-- 'checkMenuItemSetInconsistent'. -- -checkMenuItemGetInconsistent :: CheckMenuItemClass mi => mi -> IO Bool -checkMenuItemGetInconsistent mi = liftM toBool $ - {#call unsafe check_menu_item_get_inconsistent#} (toCheckMenuItem mi) +checkMenuItemGetInconsistent :: CheckMenuItemClass self => self -> IO Bool +checkMenuItemGetInconsistent self = + liftM toBool $ + {# call unsafe check_menu_item_get_inconsistent #} + (toCheckMenuItem self) #if GTK_CHECK_VERSION(2,4,0) -- | Sets whether the menu item is drawn like a 'RadioMenuItem'. -- -checkMenuItemSetDrawAsRadio :: CheckMenuItemClass mi => mi -> Bool -> IO () -checkMenuItemSetDrawAsRadio mi asRadio = - {#call check_menu_item_set_draw_as_radio#} (toCheckMenuItem mi) - (fromBool asRadio) +-- * Available since Gtk version 2.4 +-- +checkMenuItemSetDrawAsRadio :: CheckMenuItemClass self => self -> Bool -> IO () +checkMenuItemSetDrawAsRadio self drawAsRadio = + {# call check_menu_item_set_draw_as_radio #} + (toCheckMenuItem self) + (fromBool drawAsRadio) -- | Returns whether the menu item is drawn like a 'RadioMenuItem'. -- -checkMenuItemGetDrawAsRadio :: CheckMenuItemClass mi => mi -> IO Bool -checkMenuItemGetDrawAsRadio mi = liftM toBool $ - {#call unsafe check_menu_item_get_draw_as_radio#} (toCheckMenuItem mi) +-- * Available since Gtk version 2.4 +-- +checkMenuItemGetDrawAsRadio :: CheckMenuItemClass self => self -> IO Bool +checkMenuItemGetDrawAsRadio self = + liftM toBool $ + {# call unsafe check_menu_item_get_draw_as_radio #} + (toCheckMenuItem self) #endif -------------------- @@ -169,7 +206,7 @@ -- -- Default value: @False@ -- -checkMenuItemActive :: Attr CheckMenuItem Bool +checkMenuItemActive :: CheckMenuItemClass self => Attr self Bool checkMenuItemActive = Attr checkMenuItemGetActive checkMenuItemSetActive @@ -178,7 +215,7 @@ -- -- Default value: @False@ -- -checkMenuItemInconsistent :: Attr CheckMenuItem Bool +checkMenuItemInconsistent :: CheckMenuItemClass self => Attr self Bool checkMenuItemInconsistent = Attr checkMenuItemGetInconsistent checkMenuItemSetInconsistent @@ -187,7 +224,7 @@ -- -- Default value: @False@ -- -checkMenuItemDrawAsRadio :: Attr CheckMenuItem Bool +checkMenuItemDrawAsRadio :: CheckMenuItemClass self => Attr self Bool checkMenuItemDrawAsRadio = Attr checkMenuItemGetDrawAsRadio checkMenuItemSetDrawAsRadio Index: Toolbar.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs.pp,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Toolbar.chs.pp 13 Mar 2005 19:34:35 -0000 1.4 +++ Toolbar.chs.pp 2 Apr 2005 16:52:50 -0000 1.5 @@ -24,10 +24,10 @@ -- Stability : provisional -- Portability : portable (depends on GHC) -- --- Create bars of buttons and other widgets. +-- Create bars of buttons and other widgets -- module Graphics.UI.Gtk.MenuComboToolbar.Toolbar ( --- * Description +-- * Detail -- -- | This widget underwent a signficant overhaul in gtk 2.4 and the -- recommended api changed substantially. The old interface is still supported @@ -37,29 +37,19 @@ -- -- A toolbar is created with a call to 'toolbarNew'. -- --- A toolbar can contain instances of a subclass of "ToolItem". To add a --- "ToolItem" to the a toolbar, use 'toolbarInsert'. To remove an item from the +-- A toolbar can contain instances of a subclass of 'ToolItem'. To add a +-- 'ToolItem' to the a toolbar, use 'toolbarInsert'. To remove an item from the -- toolbar use 'containerRemove'. To add a button to the toolbar, add an --- instance of "ToolButton". +-- instance of 'ToolButton'. -- -- Toolbar items can be visually grouped by adding instances of --- "SeparatorToolItem" to the toolbar. If a "SeparatorToolItem" has the --- \"expand\" property set to True and the \"draw\" property set to False +-- 'SeparatorToolItem' to the toolbar. If a 'SeparatorToolItem' has the +-- \"expand\" property set to @True@ and the \"draw\" property set to @False@ -- the effect is to force all following items to the end of the toolbar. -- -- Creating a context menu for the toolbar can be done using -- 'onPopupContextMenu'. --- * Class Hierarchy --- | --- @ --- | 'GObject' --- | +----'Object' --- | +----'Widget' --- | +----'Container' --- | +----Toolbar --- @ - #ifndef DISABLE_DEPRECATED -- | * The following information applies to the old interface only. -- @@ -80,6 +70,16 @@ -- honored this way. #endif +-- * Class Hierarchy +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----'Widget' +-- | +----'Container' +-- | +----Toolbar +-- @ + -- * Types Toolbar, ToolbarClass, @@ -175,11 +175,13 @@ -------------------- -- Constructors --- | Create a new, empty toolbar. +-- | Creates a new toolbar. -- toolbarNew :: IO Toolbar -toolbarNew = makeNewObject mkToolbar $ liftM castPtr - {#call unsafe toolbar_new#} +toolbarNew = + makeNewObject mkToolbar $ + liftM (castPtr :: Ptr Widget -> Ptr Toolbar) $ + {# call unsafe toolbar_new #} -- Make tooltips or not? -- @@ -194,324 +196,446 @@ #ifndef DISABLE_DEPRECATED -- | Insert a new 'Button' into the 'Toolbar'. -- --- * The new 'Button' is created at position @pos@, counting --- from 0. +-- The new 'Button' is created at position @pos@, counting from 0. -- --- * The icon and label for the button is referenced by @stockId@ --- which must be a valid entry in the 'Toolbar's Style or the --- default 'IconFactory'. +-- The icon and label for the button is referenced by @stockId@ +-- which must be a valid entry in the 'Toolbar's Style or the +-- default 'IconFactory'. -- --- * If you whish to have 'Tooltips' added to this button you can --- specify @Just (tipText, tipPrivate)@ , otherwise specify --- @Nothing@. +-- If you whish to have 'Tooltips' added to this button you can +-- specify @Just (tipText, tipPrivate)@ , otherwise specify @Nothing@. -- --- * The newly created 'Button' is returned. Use this button to --- add an action function with @\"connectToClicked\"@. +-- The newly created 'Button' is returned. Use this button to +-- add an action function with @\"connectToClicked\"@. -- -toolbarInsertNewButton :: ToolbarClass tb => tb -> Int -> String -> - Maybe (String,String) -> IO Button -toolbarInsertNewButton tb pos stockId tooltips = +-- * Warning: this function is deprecated and should not be used in +-- newly-written code. +-- +toolbarInsertNewButton :: ToolbarClass self => self + -> Int + -> String + -> Maybe (String,String) + -> IO Button +toolbarInsertNewButton self pos stockId tooltips = withUTFString stockId $ \stockPtr -> mkToolText tooltips $ \textPtr privPtr -> makeNewObject mkButton $ liftM castPtr $ - {#call unsafe toolbar_insert_stock#} (toToolbar tb) stockPtr textPtr privPtr - nullFunPtr nullPtr (fromIntegral pos) + {# call unsafe toolbar_insert_stock #} + (toToolbar self) + stockPtr + textPtr + privPtr + nullFunPtr + nullPtr + (fromIntegral pos) -- | Append a new 'Button' to the 'Toolbar'. -- --- * See 'toolbarInsertNewButton' for details. +-- See 'toolbarInsertNewButton' for details. -- -toolbarAppendNewButton :: ToolbarClass tb => tb -> String -> - Maybe (String,String) -> IO Button -toolbarAppendNewButton tb = toolbarInsertNewButton tb (-1) +-- * Warning: this function is deprecated and should not be used in +-- newly-written code. +-- +toolbarAppendNewButton :: ToolbarClass self => self + -> String + -> Maybe (String, String) + -> IO Button +toolbarAppendNewButton self = toolbarInsertNewButton self (-1) -- | Prepend a new 'Button' to the 'Toolbar'. -- --- * See 'toolbarInsertNewButton' for details. +-- See 'toolbarInsertNewButton' for details. -- -toolbarPrependNewButton :: ToolbarClass tb => tb -> String -> - Maybe (String,String) -> IO Button -toolbarPrependNewButton tb = toolbarInsertNewButton tb 0 +-- * Warning: this function is deprecated and should not be used in +-- newly-written code. +-- +toolbarPrependNewButton :: ToolbarClass self => self + -> String + -> Maybe (String, String) + -> IO Button +toolbarPrependNewButton self = toolbarInsertNewButton self 0 -- | Insert a new 'ToggleButton' into the 'Toolbar'. -- --- * See 'toolbarInsertNewButton' for details. +-- See 'toolbarInsertNewButton' for details. -- --- * Mnemonics in the label of the 'StockItem' are removed as they do --- not work due to the bad interface definition of GtkToolbar. +-- * Warning: this function is deprecated and should not be used in +-- newly-written code. -- -toolbarInsertNewToggleButton :: ToolbarClass tb => tb -> Int -> String -> - Maybe (String,String) -> IO ToggleButton -toolbarInsertNewToggleButton tb pos stockId tooltips = do +toolbarInsertNewToggleButton :: ToolbarClass self => self + -> Int + -> String + -> Maybe (String, String) + -> IO ToggleButton +toolbarInsertNewToggleButton self pos stockId tooltips = do mItem <- stockLookupItem stockId item <- case mItem of (Just item) -> return item Nothing -> liftM fromJust $ stockLookupItem stockMissingImage let label = (filter (/= '_')) $ siLabel item - size <- toolbarGetIconSize (toToolbar tb) + size <- toolbarGetIconSize (toToolbar self) image <- imageNewFromStock stockId size makeNewObject mkToggleButton $ liftM castPtr $ withUTFString label $ \lblPtr -> mkToolText tooltips $ \textPtr privPtr -> - {#call unsafe toolbar_insert_element#} (toToolbar tb) + {#call unsafe toolbar_insert_element#} (toToolbar self) toolbarChildToggleButton (mkWidget nullForeignPtr) lblPtr textPtr privPtr (toWidget image) nullFunPtr nullPtr (fromIntegral pos) -- | Append a new 'ToggleButton' to the 'Toolbar'. -- --- * See 'toolbarInsertNewButton' for details. +-- See 'toolbarInsertNewButton' for details. -- --- * Mnemonics in the label of the 'StockItem' are removed as they do --- not work due to the bad interface definition of GtkToolbar. +-- * Warning: this function is deprecated and should not be used in +-- newly-written code. -- -toolbarAppendNewToggleButton :: ToolbarClass tb => tb -> String -> - Maybe (String,String) -> IO ToggleButton -toolbarAppendNewToggleButton tb = toolbarInsertNewToggleButton tb (-1) +toolbarAppendNewToggleButton :: ToolbarClass self => self + -> String + -> Maybe (String, String) + -> IO ToggleButton +toolbarAppendNewToggleButton self = toolbarInsertNewToggleButton self (-1) -- | Prepend a new 'ToggleButton' to the 'Toolbar'. -- --- * See 'toolbarInsertNewButton' for details. +-- See 'toolbarInsertNewButton' for details. -- --- * Mnemonics in the label of the 'StockItem' are removed as they do --- not work due to the bad interface definition of GtkToolbar. +-- * Warning: this function is deprecated and should not be used in +-- newly-written code. -- -toolbarPrependNewToggleButton :: ToolbarClass tb => tb -> String -> - Maybe (String,String) -> IO ToggleButton -toolbarPrependNewToggleButton tb = toolbarInsertNewToggleButton tb 0 +toolbarPrependNewToggleButton :: ToolbarClass self => self + -> String + -> Maybe (String, String) + -> IO ToggleButton +toolbarPrependNewToggleButton self = toolbarInsertNewToggleButton self 0 -- | Insert a new 'RadioButton' into the 'Toolbar'. -- --- * See 'toolbarInsertNewButton' for details. +-- See 'toolbarInsertNewButton' for details. -- --- * Mnemonics in the label of the 'StockItem' are removed as they do --- not work due to the bad interface definition of GtkToolbar. +-- * Warning: this function is deprecated and should not be used in +-- newly-written code. -- --- * The @parent@ argument must be set to another --- 'RadioButton' in the group. If @Nothing@ is given, --- a new group is generated (which is the desired behavious for the --- first button of a gro... [truncated message content] |
|
From: Duncan C. <dun...@us...> - 2005-04-01 22:55:52
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20043 Modified Files: ChangeLog Log Message: More ApiGen updates: ModuleScan.hs, ApiGen.hs, Template.chs: do rcs version and timestamps. CodeGen.hs, MarshalFixup.hs: add support for ignoring documentation of selected parameters or return values. Often the docs for these in the original C docs are rather pointless. gapi2xml.pl: minor change from upstream. README: update to reflect recent changes. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.409 retrieving revision 1.410 diff -u -d -r1.409 -r1.410 --- ChangeLog 31 Mar 2005 16:39:17 -0000 1.409 +++ ChangeLog 1 Apr 2005 22:55:10 -0000 1.410 @@ -1,3 +1,16 @@ +2005-04-1 Duncan Coutts <du...@co...> + + * tools/apiGen/ModuleScan.hs, tools/apiGen/ApiGen.hs, + tools/apiGen/Template.chs: do rcs version and timestamps. + + * tools/apiGen/README: update to reflect recent changes. + + * tools/apiGen/CodeGen.hs, tools/apiGen/MarshalFixup.hs: add support + for ignoring documentation of selected parameters or return values. + Often the docs for these in the original C docs are rather pointless. + + * tools/apiGen/gapi2xml.pl: minor change from upstream. + 2005-03-31 Duncan Coutts <du...@co...> * tools/apiGen/Makefile: update to latest versions of source code for |
|
From: Duncan C. <dun...@us...> - 2005-04-01 22:55:34
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20043/tools/apiGen Modified Files: ModuleScan.hs ApiGen.hs Template.chs README CodeGen.hs MarshalFixup.hs gapi2xml.pl Log Message: More ApiGen updates: ModuleScan.hs, ApiGen.hs, Template.chs: do rcs version and timestamps. CodeGen.hs, MarshalFixup.hs: add support for ignoring documentation of selected parameters or return values. Often the docs for these in the original C docs are rather pointless. gapi2xml.pl: minor change from upstream. README: update to reflect recent changes. Index: Template.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Template.chs,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- Template.chs 27 Feb 2005 20:02:14 -0000 1.9 +++ Template.chs 1 Apr 2005 22:55:22 -0000 1.10 @@ -1,5 +1,5 @@ -- -*-haskell-*- --- GIMP Toolkit (GTK) Widget @OBJECT_NAME@ +-- GIMP Toolkit (GTK) @OBJECT_KIND@ @OBJECT_NAME@ -- -- Author : @AUTHORS@ -- Index: ModuleScan.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ModuleScan.hs,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- ModuleScan.hs 25 Mar 2005 19:14:39 -0000 1.6 +++ ModuleScan.hs 1 Apr 2005 22:55:22 -0000 1.7 @@ -23,6 +23,8 @@ module_filename :: String, module_authors :: [String], module_created :: String, + module_rcs_version :: String, + module_rcs_timestamp :: String, module_copyright_dates :: Either String (String, String), -- eg "2004" or "2004-2005" module_copyright_holders :: [String], @@ -42,6 +44,7 @@ data Line = None | Authors [String] | Created String + | Version String String String String | Copyright (Either String (String, String)) [String] | Module String String | Export String @@ -133,6 +136,10 @@ module_filename = "", module_authors = head $ [ authors | Authors authors <- headerLines ] ++ [[missing]], module_created = head $ [ created | Created created <- headerLines ] ++ [missing], + module_rcs_version = head $ [ major ++ "." ++ minor + | Version major minor _ _ <- headerLines ] ++ [""], + module_rcs_timestamp = head $ [ date ++ " " ++ time + | Version _ _ date time <- headerLines ] ++ [""], module_copyright_dates = head $ [ dates | Copyright dates _ <- headerLines ] ++ [Left missing], module_copyright_holders = head $ [ authors | Copyright _ authors <- headerLines ] ++ [[missing]], module_exports = let exportLines = takeWhile (not.isExportEndLine) @@ -156,6 +163,7 @@ scanLine :: String -> [String] -> Line scanLine _ ("--":"Author":":":author) = scanAuthor author scanLine _ ("--":"Created:":created) = Created (unwords created) +scanLine _ ["--","Version",_,major,".",minor,_,_,_,date,time,_] = Version major minor date time scanLine _ ("--":"Copyright":"(":c:")":copyright) = scanCopyright copyright scanLine (' ':' ':_) ("module":moduleName) = Export (concat moduleName) scanLine _ ("module":moduleName) = scanModuleName moduleName Index: CodeGen.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/CodeGen.hs,v retrieving revision 1.15 retrieving revision 1.16 diff -u -d -r1.15 -r1.16 --- CodeGen.hs 31 Mar 2005 16:39:19 -0000 1.15 +++ CodeGen.hs 1 Apr 2005 22:55:22 -0000 1.16 @@ -14,7 +14,7 @@ import StringUtils import ModuleScan import MarshalFixup (stripKnownPrefixes, maybeNullParameter, maybeNullResult, - fixCFunctionName, leafClass) + fixCFunctionName, leafClass, nukeParameterDocumentation) import Prelude hiding (Enum, lines) import List (groupBy, sortBy, isPrefixOf, isSuffixOf, partition, find) @@ -57,7 +57,10 @@ let types | returnType' == "()" = types' | otherwise = returnType' : types' docs = mergeParamDocs (lookup "Returns" paramDocMap) docs' - in ("IO (" ++ sepBy ", " types "" ++ ")", docs) + in (case types of + [t] -> "IO " ++ t + ts -> "IO (" ++ sepBy ", " types "" ++ ")" + ,docs) (outParamMarshalersBefore, outParamMarshalersAfter, returnOutParamFragments) = unzip3 [ genMarshalOutParameter outParamType (changeIllegalNames (cParamNameToHsName name)) | (OutParam outParamType, name) <- paramTypes' ] @@ -90,7 +93,9 @@ else [DocArg (paramdoc_name paramdoc) ,DocText " - "] ) ++ paramdoc_paragraph paramdoc) - | paramdoc <- funcdoc_params doc ] + | paramdoc <- funcdoc_params doc + , not (nukeParameterDocumentation (method_cname method) + (paramdoc_name paramdoc))] formatParamTypes :: [(String, Maybe [DocParaSpan])] -> ShowS formatParamTypes paramTypes = format True False paramTypes Index: gapi2xml.pl =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/gapi2xml.pl,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- gapi2xml.pl 1 Mar 2005 21:20:45 -0000 1.3 +++ gapi2xml.pl 1 Apr 2005 22:55:22 -0000 1.4 @@ -186,6 +186,8 @@ $objects{$1} = $2 . $objects{$1}; } elsif ($cast_macro =~ /GTK_CHECK_CLASS_CAST.*,\s*(\w+),\s*(\w+)/) { $objects{$1} .= ":$2"; + } elsif ($cast_macro =~ /GST_IMPLEMENTS_INTERFACE_CHECK_INSTANCE_CAST.*,\s*(\w+),\s*(\w+)/) { + $objects{$1} = $2 . $objects{$1}; } } elsif ($line =~ /INSTANCE_GET_INTERFACE.*,\s*(\w+),\s*(\w+)/) { $ifaces{$1} = $2; Index: ApiGen.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ApiGen.hs,v retrieving revision 1.21 retrieving revision 1.22 diff -u -d -r1.21 -r1.22 --- ApiGen.hs 25 Mar 2005 19:14:54 -0000 1.21 +++ ApiGen.hs 1 Apr 2005 22:55:22 -0000 1.22 @@ -148,7 +148,9 @@ module_filename = object_name object ++ ".chs", module_authors = ["[Insert your full name here]"], module_created = date, - module_copyright_dates = Left year, + module_rcs_version = "", + module_rcs_timestamp = "", + module_copyright_dates = Left year, module_copyright_holders = ["[Insert your full name here]"], module_exports = [], module_imports = [], @@ -161,8 +163,11 @@ case var of "YEAR" -> ss $ formatCopyrightDates year (module_copyright_dates moduleInfo) "DATE" -> ss $ module_created moduleInfo + "OBJECT_KIND" -> ss $ if object_isinterface object then "Interface" else "Widget" "OBJECT_NAME" -> ss $ module_name moduleInfo "AUTHORS" -> ss $ concat $ intersperse ", " $ module_authors moduleInfo + "RCS_VERSION" -> ss $ module_rcs_version moduleInfo + "RCS_TIMESTAMP" -> ss $ module_rcs_timestamp moduleInfo "COPYRIGHT" -> ss $ concat $ intersperse ", " $ module_copyright_holders moduleInfo "DESCRIPTION" -> haddocFormatParas knownTypes False (moduledoc_summary moduleDoc) "DOCUMENTATION" -> genModuleDocumentation knownTypes moduleDoc Index: README =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/README,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- README 26 Jan 2005 12:13:28 -0000 1.4 +++ README 1 Apr 2005 22:55:22 -0000 1.5 @@ -16,9 +16,6 @@ eg for possibly NULL Strings you would want to change to use Maybe String also it is not possible to automatically determine the element type of GLists so this will have to be determined manually. - * Some functions have multiple out parameters which would be better done in - Haskell by returning a tuple (this may be possible to do automatically but - currently it is not). * Documentation. This is converted directly from the C documentation so there are usually things that you would want to change to make things make sense in Haskell. Code samples should be converted for example. @@ -56,8 +53,3 @@ Some improvements that would be good: * Complete marshaling code for more types - * Emit signal and property bindings with documentation - * Deal with Enums, Flags, and Interfaces properly - - make objects instances of interfaces they implement - - make a note of structs and boxed types - - allow import of parent api files for reference to known types Index: MarshalFixup.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/MarshalFixup.hs,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- MarshalFixup.hs 25 Mar 2005 19:14:55 -0000 1.4 +++ MarshalFixup.hs 1 Apr 2005 22:55:22 -0000 1.5 @@ -104,6 +104,59 @@ maybeNullResult "gtk_notebook_get_tab_label_text" = True maybeNullResult _ = False +-- Often the documentation for parameters or the return value of functions +-- that is included in the gtk-doc docs are just pointless. So this table +-- lists the function and parameter names for which we do not want to use the +-- gtk-doc documentation. +nukeParameterDocumentation :: String -> String -> Bool +nukeParameterDocumentation "gtk_button_box_get_layout" "Returns" = True +nukeParameterDocumentation "gtk_button_set_label" "label" = True +nukeParameterDocumentation "gtk_button_get_label" "Returns" = True +nukeParameterDocumentation "gtk_toggle_button_get_active" "Returns" = True +nukeParameterDocumentation "gtk_image_new_from_file" "filename" = True +nukeParameterDocumentation "gtk_image_new_from_pixbuf" "pixbuf" = True +nukeParameterDocumentation "gtk_label_new" "str" = True +nukeParameterDocumentation "gtk_label_set_text" "str" = True +nukeParameterDocumentation "gtk_label_set_label" "str" = True +nukeParameterDocumentation "gtk_label_set_justify" "jtype" = True +nukeParameterDocumentation "gtk_label_get_justify" "Returns" = True +nukeParameterDocumentation "gtk_label_set_use_underline" "setting" = True +nukeParameterDocumentation "gtk_label_get_use_underline" "Returns" = True +nukeParameterDocumentation "gtk_label_get_text" "Returns" = True +nukeParameterDocumentation "gtk_label_get_label" "Returns" = True +nukeParameterDocumentation "gtk_label_set_text_with_mnemonic" "str" = True +nukeParameterDocumentation "gtk_progress_bar_set_text" "text" = True +nukeParameterDocumentation "gtk_progress_bar_get_orientation" "Returns" = True +nukeParameterDocumentation "gtk_progress_bar_set_orientation" "orientation" = True +nukeParameterDocumentation "gtk_statusbar_set_has_resize_grip" "setting" = True +nukeParameterDocumentation "gtk_statusbar_get_has_resize_grip" "Returns" = True +nukeParameterDocumentation "gtk_editable_get_editable" "Returns" = True +nukeParameterDocumentation "gtk_entry_set_text" "text" = True +nukeParameterDocumentation "gtk_entry_get_text" "Returns" = True +nukeParameterDocumentation "gtk_entry_append_text" "text" = True +nukeParameterDocumentation "gtk_entry_prepend_text" "text" = True +nukeParameterDocumentation "gtk_entry_set_invisible_char" "ch" = True +nukeParameterDocumentation "gtk_entry_set_has_frame" "setting" = True +nukeParameterDocumentation "gtk_entry_set_completion" "completion" = True +nukeParameterDocumentation "spin_button_get_value" "Returns" = True +nukeParameterDocumentation "spin_button_get_value_as_int" "Returns" = True +nukeParameterDocumentation "spin_button_set_value" "value" = True +nukeParameterDocumentation "gtk_expander_new" "label" = True +nukeParameterDocumentation "gtk_expander_set_expanded" "expanded" = True +nukeParameterDocumentation "gtk_expander_get_expanded" "Returns" = True +nukeParameterDocumentation "gtk_expander_set_spacing" "spacing" = True +nukeParameterDocumentation "gtk_expander_set_label" "label" = True +nukeParameterDocumentation "gtk_expander_get_label" "Returns" = True +nukeParameterDocumentation "gtk_expander_get_use_markup" "Returns" = True +nukeParameterDocumentation "gtk_fixed_set_has_window" "hasWindow" = True +nukeParameterDocumentation "gtk_fixed_get_has_window" "Returns" = True +nukeParameterDocumentation "gtk_notebook_get_n_pages" "Returns" = True +nukeParameterDocumentation "gtk_adjustment_set_value" "value" = True +nukeParameterDocumentation "gtk_adjustment_get_value" "Returns" = True +nukeParameterDocumentation "gtk_arrow_new" "arrowType" = True +nukeParameterDocumentation "gtk_arrow_new" "shadowType" = True +nukeParameterDocumentation _ _ = False + -- On win32 for glib/gtk 2.6 they changed the interpretation of functions that -- take or return system file names (as opposed to user displayable -- representations of file names). Previously the string encoding of the file |
|
From: Duncan C. <dun...@us...> - 2005-03-31 16:39:35
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23496/tools/apiGen Modified Files: Makefile CodeGen.hs Marshal.hs Log Message: ApiGen update: Makefile: update to latest versions of source code for all packages. CodeGen.hs: generalise parameter marshaling to include 'out' parameters as well as ordinary 'in' parameters and hidden / internal parameters. Also deal with 'shared' methods. These methods are like Java static methods. They take no self/object parameter. Marshal.hs: add support for marshaling the most common out parameter types: gboolean*, gint*, guint*, gfloat*, gdouble* and gchar**. Also add 'in' and return marshaling for a couple other misc types like fixed width integral types: guint16 and guint32. Index: Marshal.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Marshal.hs,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- Marshal.hs 25 Mar 2005 19:14:55 -0000 1.9 +++ Marshal.hs 31 Mar 2005 16:39:19 -0000 1.10 @@ -2,7 +2,9 @@ KnownSymbols, CSymbol(..), EnumKind(..), + ParameterKind(..), genMarshalParameter, + genMarshalOutParameter, genMarshalResult, genMarshalProperty, convertSignalType, @@ -47,59 +49,76 @@ -- Here's the interesting bit that generates the fragments of mashaling code ------------------------------------------------------------------------------- +data ParameterKind = InParam String + | OutParam String + | UnusedParam + genMarshalParameter :: KnownSymbols -> --a collection of types we know to be objects or enums String -> --function name (useful to lookup per-func fixup info) String -> --parameter name suggestion (will be unique) String -> --C type decleration for the parameter we will marshal (Maybe String, --parameter class constraints (or none) - Maybe String, --parameter type (or none if the arg is not exposed) + ParameterKind, --parameter type (or UnusedParam if the arg is not exposed) ShowS -> ShowS) --marshaling code (\body -> ... body ...) genMarshalParameter _ _ name "gboolean" = - (Nothing, Just "Bool", + (Nothing, InParam "Bool", \body -> body. indent 2. ss "(fromBool ". ss name. ss ")") genMarshalParameter _ _ name typeName - | typeName == "guint" --these two are unsigned types - || typeName == "gint" - || typeName == "int" - || typeName == "gsize" --should they be Word or Int? - || typeName == "gssize" = - (Nothing, Just "Int", + | typeName == "guint" --these two are unsigned types + || typeName == "gint" + || typeName == "glong" + || typeName == "int" + || typeName == "gsize" --should they be Word or Int? + || typeName == "gssize" = + (Nothing, InParam "Int", \body -> body. indent 2. ss "(fromIntegral ". ss name. ss ")") -genMarshalParameter _ _ name "gdouble" = - (Nothing, Just "Double", +genMarshalParameter _ _ name "guint16" = + (Nothing, InParam "Word16", + \body -> body. + indent 2. ss "(fromIntegral ". ss name. ss ")") + +genMarshalParameter _ _ name "guint32" = + (Nothing, InParam "Word32", + \body -> body. + indent 2. ss "(fromIntegral ". ss name. ss ")") + +genMarshalParameter _ _ name typeName + | typeName == "gdouble" + || typeName == "double" = + (Nothing, InParam "Double", \body -> body. indent 2. ss "(realToFrac ". ss name. ss ")") genMarshalParameter _ _ name "gfloat" = - (Nothing, Just "Float", + (Nothing, InParam "Float", \body -> body. indent 2. ss "(realToFrac ". ss name. ss ")") genMarshalParameter _ _ name "gunichar" = - (Nothing, Just "Char", + (Nothing, InParam "Char", \body -> body. indent 2. ss "((fromIntegral . ord) ". ss name. ss ")") genMarshalParameter _ funcName name typeName | typeName == "const-gchar*" || typeName == "const-char*" = if maybeNullParameter funcName name - then (Nothing, Just "Maybe String", + then (Nothing, InParam "Maybe String", \body -> ss "maybeWith withUTFString ". ss name. ss " $ \\". ss name. ss "Ptr ->". indent 1. body. indent 2. ss name. ss "Ptr") - else (Nothing, Just "String", + else (Nothing, InParam "String", \body -> ss "withUTFString ". ss name. ss " $ \\". ss name. ss "Ptr ->". indent 1. body. indent 2. ss name. ss "Ptr") genMarshalParameter _ _ name "GError**" = - (Nothing, Nothing, + (Nothing, UnusedParam, \body -> ss "propagateGError $ \\". ss name. ss "Ptr ->". indent 1. body. indent 2. ss name. ss "Ptr") @@ -113,8 +132,8 @@ let classContext | leafClass typeName = Nothing | otherwise = Just $ shortTypeName ++ "Class " ++ name - argType = Just $ (if maybeNullParameter funcName name then "Maybe " else "") - ++ (if leafClass typeName then shortTypeName else name) + argType = (if maybeNullParameter funcName name then "Maybe " else "") + ++ (if leafClass typeName then shortTypeName else name) implementation | leafClass typeName && maybeNullParameter funcName name = ss "(fromMaybe (". ss shortTypeName. ss " nullForeignPtr) ". @@ -124,7 +143,7 @@ = ss "(maybe (". ss shortTypeName. ss " nullForeignPtr) to". ss shortTypeName. sc ' '. ss name. sc ')' | otherwise = ss "(to". ss shortTypeName. sc ' '. ss name. sc ')' - in (classContext, argType, + in (classContext, InParam argType, \body -> body. indent 2. implementation) where typeName = init typeName' @@ -135,7 +154,7 @@ genMarshalParameter knownSymbols _ name typeName | isUpper (head typeName) && symbolIsEnum typeKind = - (Nothing, Just shortTypeName, + (Nothing, InParam shortTypeName, \body -> body. indent 2. ss "((fromIntegral . fromEnum) ". ss name. ss ")") where shortTypeName = stripKnownPrefixes typeName @@ -145,34 +164,86 @@ genMarshalParameter knownSymbols _ name typeName | isUpper (head typeName) && symbolIsFlags typeKind = - (Nothing, Just ("[" ++ shortTypeName ++ "]"), + (Nothing, InParam ("[" ++ shortTypeName ++ "]"), \body -> body. indent 2. ss "((fromIntegral . fromFlags) ". ss name. ss ")") where shortTypeName = stripKnownPrefixes typeName typeKind = lookupFM knownSymbols typeName genMarshalParameter _ _ name textIter | textIter == "const-GtkTextIter*" - || textIter == "GtkTextIter*" = - (Nothing, Just "TextIter", + || textIter == "GtkTextIter*" = + (Nothing, InParam "TextIter", \body -> body. indent 2. ss name) genMarshalParameter _ _ name "GtkTreeIter*" = - (Nothing, Just "TreeIter", + (Nothing, InParam "TreeIter", \body -> body. indent 2. ss name) genMarshalParameter _ _ name "GtkTreePath*" = - (Nothing, Just "TreePath", + (Nothing, InParam "TreePath", \body -> ss "withTreePath ". ss name. ss " $ \\". ss name. ss " ->". indent 1. body. indent 2. ss name) +-- Out parameters ------------------------------- + +genMarshalParameter _ _ name "gboolean*" = + (Nothing, OutParam "Boolean", + \body -> body. + indent 2. ss name. ss "Ptr") + +genMarshalParameter _ _ name typeName + | typeName == "gint*" + || typeName == "guint*" = + (Nothing, OutParam "Int", + \body -> body. + indent 2. ss name. ss "Ptr") + +genMarshalParameter _ _ name "gfloat*" = + (Nothing, OutParam "Float", + \body -> body. + indent 2. ss name. ss "Ptr") + +genMarshalParameter _ _ name "gdouble*" = + (Nothing, OutParam "Double", + \body -> body. + indent 2. ss name. ss "Ptr") + +genMarshalParameter _ _ name "gchar**" = + (Nothing, OutParam "String", + \body -> body. + indent 2. ss name. ss "Ptr") + +-- Catch all case ------------------------------- genMarshalParameter _ _ name unknownType = - (Nothing, Just $ "{-" ++ unknownType ++ "-}", + (Nothing, InParam $ "{-" ++ unknownType ++ "-}", \body -> body. indent 2. ss "{-". ss name. ss "-}") +genMarshalOutParameter :: String -> String -> (ShowS, ShowS, ShowS) +genMarshalOutParameter "Boolean" name = (ss "alloca $ \\". ss name. ss "Ptr ->". indent 1 + ,indent 1. ss "peek ". ss name. ss "Ptr >>= \\". ss name. ss " ->" + ,ss "toBool ". ss name) + +genMarshalOutParameter "Int" name = (ss "alloca $ \\". ss name. ss "Ptr ->". indent 1 + ,indent 1. ss "peek ". ss name. ss "Ptr >>= \\". ss name. ss " ->" + ,ss "fromIntegral ". ss name) + +genMarshalOutParameter "Float" name = (ss "alloca $ \\". ss name. ss "Ptr ->". indent 1 + ,indent 1. ss "peek ". ss name. ss "Ptr >>= \\". ss name. ss " ->" + ,ss "realToFrac ". ss name) + +genMarshalOutParameter "Double" name = (ss "alloca $ \\". ss name. ss "Ptr ->". indent 1 + ,indent 1. ss "peek ". ss name. ss "Ptr >>= \\". ss name. ss " ->" + ,ss "realToFrac ". ss name) +genMarshalOutParameter "String" name = (ss "alloca $ \\". ss name. ss "Ptr ->". indent 1 + ,indent 1. ss "peek ". ss name. ss "Ptr >>= readUTFString >>= \\". ss name. ss " ->" + ,ss name) + +genMarshalOutParameter paramType name = (id, id, ss name) + -- Takes the type string and returns the Haskell Type and the marshaling code -- genMarshalResult :: @@ -185,6 +256,8 @@ genMarshalResult _ _ _ "gboolean" = ("Bool", \body -> ss "liftM toBool $". indent 1. body) genMarshalResult _ _ _ "gint" = ("Int", \body -> ss "liftM fromIntegral $". indent 1. body) genMarshalResult _ _ _ "guint" = ("Int", \body -> ss "liftM fromIntegral $". indent 1. body) +genMarshalResult _ _ _ "guint16" = ("Word16", \body -> ss "liftM fromIntegral $". indent 1. body) +genMarshalResult _ _ _ "guint32" = ("Word32", \body -> ss "liftM fromIntegral $". indent 1. body) genMarshalResult _ _ _ "gdouble" = ("Double", \body -> ss "liftM realToFrac $". indent 1. body) genMarshalResult _ _ _ "gfloat" = ("Float", \body -> ss "liftM realToFrac $". indent 1. body) genMarshalResult _ _ _ "gunichar" = ("Char", \body -> ss "liftM (chr . fromIntegral) $". indent 1. body) @@ -197,7 +270,9 @@ else ("String", \body -> body. indent 1. ss ">>= peekUTFString") -genMarshalResult _ funcName _ "gchar*" = +genMarshalResult _ funcName _ typeName + | typeName == "gchar*" + || typeName == "char*" = if maybeNullResult funcName then ("(Maybe String)", \body -> body. @@ -312,6 +387,7 @@ convertSignalType _ "gboolean" = ("BOOL", "Bool") convertSignalType _ "gint" = ("INT", "Int") convertSignalType _ "guint" = ("UINT", "Int") +convertSignalType _ "guint32" = ("UINT", "Int") convertSignalType _ "glong" = ("LONG", "Int") convertSignalType _ "gulong" = ("ULONG", "Int") convertSignalType _ "gfloat" = ("FLOAT", "Float") Index: CodeGen.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/CodeGen.hs,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- CodeGen.hs 25 Mar 2005 19:14:55 -0000 1.14 +++ CodeGen.hs 31 Mar 2005 16:39:19 -0000 1.15 @@ -18,7 +18,7 @@ import Prelude hiding (Enum, lines) import List (groupBy, sortBy, isPrefixOf, isSuffixOf, partition, find) -import Maybe (isNothing, fromMaybe) +import Maybe (isNothing, fromMaybe, catMaybes) import Data.FiniteMap import Debug.Trace (trace) @@ -41,22 +41,39 @@ (c, ty, m) -> (c, (ty, parameter_name p), m) | p <- method_parameters method ] classConstraints = [ c | Just c <- classConstraints' ] - paramTypes = [ (paramType, lookup name paramDocMap) - | (Just paramType, name) <- paramTypes' ] - paramNames = [ changeIllegalNames (cParamNameToHsName (parameter_name p)) - | ((Just _, _), p) <- zip paramTypes' (method_parameters method) ] - formattedParamNames = cat (map (\name -> ss name.sc ' ') paramNames) + inParamTypes = [ (paramType, lookup name paramDocMap) + | (InParam paramType, name) <- paramTypes' ] + inParamNames = [ changeIllegalNames (cParamNameToHsName (parameter_name p)) + | ((InParam _, _), p) <- zip paramTypes' (method_parameters method) ] + outParamTypes = [ (paramType, lookup name paramDocMap) + | (OutParam paramType, name) <- paramTypes' ] + formattedParamNames = cat (map (\name -> ss name.sc ' ') inParamNames) (returnType', returnMarshaler) = genMarshalResult knownSymbols (method_cname method) isConstructor (method_return_type method) - returnType = ("IO " ++ returnType', lookup "Returns" paramDocMap) - functionType = (case classConstraints of + returnType | null outParamTypes = ("IO " ++ returnType', lookup "Returns" paramDocMap) + | otherwise = case unzip outParamTypes of + (types', docs') -> + let types | returnType' == "()" = types' + | otherwise = returnType' : types' + docs = mergeParamDocs (lookup "Returns" paramDocMap) docs' + in ("IO (" ++ sepBy ", " types "" ++ ")", docs) + (outParamMarshalersBefore, outParamMarshalersAfter, returnOutParamFragments) = + unzip3 [ genMarshalOutParameter outParamType (changeIllegalNames (cParamNameToHsName name)) + | (OutParam outParamType, name) <- paramTypes' ] + returnOutParams body | null outParamTypes = body + | otherwise = body + . indent 1. ss "return (". sepBy' ", " returnOutParamFragments. ss ")" + functionType = (case classConstraints of [] -> id [c] -> ss c. ss " => " cs -> sc '('. sepBy ", " classConstraints. ss ") => "). - formatParamTypes (paramTypes ++ [returnType]) + formatParamTypes (inParamTypes ++ [returnType]) body = foldl (\body marshaler -> marshaler body) - call (paramMarshalers++[returnMarshaler]) + call (paramMarshalers + ++ [ (\body -> frag. body) | frag <- reverse outParamMarshalersBefore ] + ++ [ (\body -> body. frag) | frag <- outParamMarshalersAfter ] + ++ [returnMarshaler,returnOutParams]) call = ss (genCall (maybe (method_cname method) methodinfo_shortcname info) safety) safety = case info of Nothing -> False @@ -104,6 +121,20 @@ . concatMap (haddocFormatSpan knownSymbols docNullsAllFixed) columnIndent = maximum [ length parmType | (parmType, _) <- paramTypes ] +mergeParamDocs :: Maybe [DocParaSpan] -> [Maybe [DocParaSpan]] -> Maybe [DocParaSpan] +mergeParamDocs doc docs = + case catMaybes (doc:docs) of + [] -> Nothing + [doc] -> Just doc + docs -> let (varNames, paramDocs) = + unzip [ case doc of + doc@(DocArg varName : _) -> (cParamNameToHsName varName, doc) + _ -> ("_", doc) + | doc <- docs ] + returnValName = DocLiteral ("(" ++ sepBy ", " varNames "" ++ ")") + fixmeMessage = DocText " {FIXME: merge return value docs} " + in Just $ returnValName : fixmeMessage : concat paramDocs + genModuleBody :: KnownSymbols -> Object -> ModuleDoc -> ModuleInfo -> ShowS genModuleBody knownSymbols object apiDoc modInfo = doVersionIfDefs (sepBy' "\n\n") $ @@ -183,7 +214,9 @@ } in method { method_name = object_name object ++ method_name method, - method_parameters = self : method_parameters method + method_parameters = if method_shared method + then method_parameters method + else self : method_parameters method } genConstructors :: KnownSymbols -> Object -> [FuncDoc] -> [MethodInfo] -> [(ShowS, (Since, Deprecated))] Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Makefile,v retrieving revision 1.12 retrieving revision 1.13 diff -u -d -r1.12 -r1.13 --- Makefile 27 Mar 2005 12:59:06 -0000 1.12 +++ Makefile 31 Mar 2005 16:39:19 -0000 1.13 @@ -28,20 +28,22 @@ # # source code # -GLIB_VERSION = 2.4.8 -PANGO_VERSION = 1.4.1 -ATK_VERSION = 1.6.1 -GTK_VERSION = 2.4.14 -GLADE_VERSION = 2.0.1 -CANVAS_VERSION = 2.4.0 +GLIB_VERSION = 2.6.3 +PANGO_VERSION = 1.8.1 +ATK_VERSION = 1.9.1 +GTK_VERSION = 2.6.4 +GLADE_VERSION = 2.5.1 +CANVAS_VERSION = 2.10.0 +GNOME_PLATFORM_URL = http://ftp.gnome.org/pub/gnome/platform/2.10/2.10.0/sources +GNOME_DESKTOP_URL = http://ftp.gnome.org/pub/gnome/desktop/2.10/2.10.0/sources DOWNLOADS = \ - ftp://ftp.gtk.org/pub/gtk/v2.4/glib-$(GLIB_VERSION).tar.bz2 \ - ftp://ftp.gtk.org/pub/gtk/v2.4/pango-$(PANGO_VERSION).tar.bz2 \ - ftp://ftp.gtk.org/pub/gtk/v2.4/atk-$(ATK_VERSION).tar.bz2 \ - ftp://ftp.gtk.org/pub/gtk/v2.4/gtk+-$(GTK_VERSION).tar.bz2 \ - http://ftp.gnome.org/pub/GNOME/desktop/2.4/2.4.2/sources/libglade-$(GLADE_VERSION).tar.bz2\ - http://ftp.gnome.org/pub/GNOME/desktop/2.4/2.4.2/sources/libgnomecanvas-$(CANVAS_VERSION).tar.bz2 + $(GNOME_PLATFORM_URL)/glib-$(GLIB_VERSION).tar.bz2 \ + $(GNOME_PLATFORM_URL)/pango-$(PANGO_VERSION).tar.bz2 \ + $(GNOME_PLATFORM_URL)/atk-$(ATK_VERSION).tar.bz2 \ + $(GNOME_PLATFORM_URL)/gtk+-$(GTK_VERSION).tar.bz2 \ + $(GNOME_PLATFORM_URL)/libglade-$(GLADE_VERSION).tar.bz2 \ + $(GNOME_PLATFORM_URL)/libgnomecanvas-$(CANVAS_VERSION).tar.bz2 get-source-code: for i in $(DOWNLOADS); do \ |
|
From: Duncan C. <dun...@us...> - 2005-03-31 16:39:30
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23496 Modified Files: ChangeLog Log Message: ApiGen update: Makefile: update to latest versions of source code for all packages. CodeGen.hs: generalise parameter marshaling to include 'out' parameters as well as ordinary 'in' parameters and hidden / internal parameters. Also deal with 'shared' methods. These methods are like Java static methods. They take no self/object parameter. Marshal.hs: add support for marshaling the most common out parameter types: gboolean*, gint*, guint*, gfloat*, gdouble* and gchar**. Also add 'in' and return marshaling for a couple other misc types like fixed width integral types: guint16 and guint32. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.408 retrieving revision 1.409 diff -u -d -r1.408 -r1.409 --- ChangeLog 27 Mar 2005 12:59:05 -0000 1.408 +++ ChangeLog 31 Mar 2005 16:39:17 -0000 1.409 @@ -1,3 +1,18 @@ +2005-03-31 Duncan Coutts <du...@co...> + + * tools/apiGen/Makefile: update to latest versions of source code for + all packages. + + * tools/apiGen/CodeGen.hs: generalise parameter marshaling to include + 'out' parameters as well as ordinary 'in' parameters and hidden / + internal parameters. Also deal with 'shared' methods. These methods + are like Java static methods. They take no self/object parameter. + + * tools/apiGen/Marshal.hs: add support for marshaling the most common + out parameter types: gboolean*, gint*, guint*, gfloat*, gdouble* and + gchar**. Also add 'in' and return marshaling for a couple other misc + types like fixed width integral types: guint16 and guint32. + 2005-03-27 Duncan Coutts <du...@co...> * gtk/Graphics/UI/Gtk/Abstract/Container.chs: documentation changes |
|
From: Duncan C. <dun...@us...> - 2005-03-27 12:59:16
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15556/tools/apiGen Modified Files: ExcludeApi.hs Makefile gtk.ignore Log Message: Fix ExcludeApi / gtk.ignore bug in ApiGen program and add a bunch of internal functions to ignore when generating binding modules. Add a more detailed summary API coverage report. Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Makefile,v retrieving revision 1.11 retrieving revision 1.12 diff -u -d -r1.11 -r1.12 --- Makefile 25 Mar 2005 19:14:55 -0000 1.11 +++ Makefile 27 Mar 2005 12:59:06 -0000 1.12 @@ -166,8 +166,8 @@ # # tools # -ApiGen : ApiGen.hs Api.hs Docs.hs FormatDocs.hs \ - Marshal.hs CodeGen.hs StringUtils.hs ModuleScan.hs MarshalFixup.hs +ApiGen : ApiGen.hs Api.hs Docs.hs FormatDocs.hs CodeGen.hs Marshal.hs \ + MarshalFixup.hs ModuleScan.hs ExcludeApi.hs StringUtils.hs $(HC) --make $< -o $@ HC=ghc Index: ExcludeApi.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ExcludeApi.hs,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- ExcludeApi.hs 17 Feb 2005 13:51:35 -0000 1.1 +++ ExcludeApi.hs 27 Mar 2005 12:59:06 -0000 1.2 @@ -25,10 +25,18 @@ trim = takeWhile (not . isSpace) . dropWhile isSpace matcher :: [FilterSpec] -> (String -> Bool) -matcher spec = match - where excludeRegex = mkRegex $ concat $ intersperse "|" [ regex | Exclude regex <- spec ] - noExcludeRegex = mkRegex $ concat $ intersperse "|" [ regex | NotExclude regex <- spec ] - alwaysExcludeRegex = mkRegex $ concat $ intersperse "|" [ regex | AlwaysExclude regex <- spec ] - match line = not $ ((isJust $ matchRegex excludeRegex line) - && (not $ isJust $ matchRegex noExcludeRegex line)) - || (isJust $ matchRegex alwaysExcludeRegex line) +matcher spec line = match line + where excludeRegexFragments = [ regex | Exclude regex <- spec ] + noExcludeRegexFragments = [ regex | NotExclude regex <- spec ] + alwaysExcludeRegexFragments = [ regex | AlwaysExclude regex <- spec ] + + excludeRegex = mkRegex $ concat $ intersperse "|" excludeRegexFragments + noExcludeRegex = mkRegex $ concat $ intersperse "|" noExcludeRegexFragments + alwaysExcludeRegex = mkRegex $ concat $ intersperse "|" alwaysExcludeRegexFragments + + matchExclude line = isJust (matchRegex excludeRegex line) && not (null excludeRegexFragments) + matchNotExclude line = isJust (matchRegex noExcludeRegex line) && not (null noExcludeRegexFragments) + matchAlwaysExclude line = isJust (matchRegex alwaysExcludeRegex line) && not (null alwaysExcludeRegexFragments) + + match line = not $ (matchExclude line && (not $ matchNotExclude line)) + || matchAlwaysExclude line Index: gtk.ignore =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/gtk.ignore,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- gtk.ignore 17 Feb 2005 13:51:35 -0000 1.1 +++ gtk.ignore 27 Mar 2005 12:59:06 -0000 1.2 @@ -6,3 +6,28 @@ #these are sometimes bound if necessary but otherwise we can ignore them exclude _ref$ exclude _unref$ + +#now just a whole bunch of specific ones: +exclude gtk_window_set_wmclass + +#internal widget functions: +exclude gtk_widget_unparent +exclude gtk_widget_map +exclude gtk_widget_unmap +exclude gtk_widget_realize +exclude gtk_widget_unrealize +exclude gtk_widget_queue_resize +exclude gtk_widget_queue_resize_no_redraw +exclude gtk_widget_size_request +exclude gtk_widget_get_child_requisition +exclude gtk_widget_size_allocate +exclude gtk_widget_event +exclude gtk_widget_set_state +exclude gtk_widget_set_parent +exclude gtk_widget_ensure_style +exclude gtk_widget_reset_rc_styles + +# C convenience functions +exclude gtk_widget_hide_on_delete +exclude gtk_widget_destroyed + |
|
From: Duncan C. <dun...@us...> - 2005-03-27 12:59:16
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/apicoverage In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15556/tools/apicoverage Modified Files: Makefile Log Message: Fix ExcludeApi / gtk.ignore bug in ApiGen program and add a bunch of internal functions to ignore when generating binding modules. Add a more detailed summary API coverage report. Index: Makefile =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apicoverage/Makefile,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- Makefile 10 Jan 2005 17:25:27 -0000 1.5 +++ Makefile 27 Mar 2005 12:59:06 -0000 1.6 @@ -66,5 +66,11 @@ awk '$$1 == "<" { print $$2 }' | \ awk -F _ '{ printf("%s_%s\n", $$1, $$2) }' | uniq -c | sort -n +summary3: gtk.def.filtered gtk.coverage.filtered + @echo "**** unbound gtk functions by group ****" + @diff gtk.def.filtered gtk.coverage.filtered | \ + awk '$$1 == "<" { print $$2 }' | \ + awk -F _ '{ printf("%s_%s_%s\n", $$1, $$2, $$3) }' | uniq -c | sort -n + debug: @echo GTK_IGNORE_FILES = $(GTK_IGNORE_FILES) |
|
From: Duncan C. <dun...@us...> - 2005-03-27 12:59:16
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15556 Modified Files: ChangeLog Log Message: Fix ExcludeApi / gtk.ignore bug in ApiGen program and add a bunch of internal functions to ignore when generating binding modules. Add a more detailed summary API coverage report. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.407 retrieving revision 1.408 diff -u -d -r1.407 -r1.408 --- ChangeLog 27 Mar 2005 12:51:37 -0000 1.407 +++ ChangeLog 27 Mar 2005 12:59:05 -0000 1.408 @@ -11,6 +11,15 @@ and code formatting changes. Also added a few extra functions, in particular the ones I needed for my simulation visualiser. + * tools/apiGen/ExcludeApi.hs: fix exclude regex matcher. + + * tools/apiGen/Makefile: add ExcludeApi.hs as a dependency of ApiGen. + + * tools/apiGen/gtk.ignore: add a bunch of internal functions to ignore + when generating binding modules. + + * tools/apicoverage/Makefile: add a more detailed summary report. + 2005-03-26 Duncan Coutts <du...@co...> * mozembed/Graphics/UI/Gtk/MozEmbed.chs: use Int in the signal |
|
From: Duncan C. <dun...@us...> - 2005-03-27 12:51:51
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12169 Modified Files: ChangeLog Log Message: Documentation changes and code formatting changes. Also added a few extra functions, in particular the ones I needed for my simulation visualiser. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.406 retrieving revision 1.407 diff -u -d -r1.406 -r1.407 --- ChangeLog 27 Mar 2005 11:54:51 -0000 1.406 +++ ChangeLog 27 Mar 2005 12:51:37 -0000 1.407 @@ -1,12 +1,16 @@ 2005-03-27 Duncan Coutts <du...@co...> * gtk/Graphics/UI/Gtk/Abstract/Container.chs: documentation changes - and code formattign changes. Also added a few extra functions and a + and code formatting changes. Also added a few extra functions and a couple properties. * gtk/Graphics/UI/Gtk/Windows/Window.chs.pp: added bindings for 22 extra functions (most of which are probably useful!). + * gtk/Graphics/UI/Gtk/Abstract/Widget.chs: documentation changes + and code formatting changes. Also added a few extra functions, in + particular the ones I needed for my simulation visualiser. + 2005-03-26 Duncan Coutts <du...@co...> * mozembed/Graphics/UI/Gtk/MozEmbed.chs: use Int in the signal |
|
From: Duncan C. <dun...@us...> - 2005-03-27 12:51:49
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Abstract In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12169/gtk/Graphics/UI/Gtk/Abstract Modified Files: Widget.chs Log Message: Documentation changes and code formatting changes. Also added a few extra functions, in particular the ones I needed for my simulation visualiser. Index: Widget.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Abstract/Widget.chs,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- Widget.chs 13 Mar 2005 19:34:32 -0000 1.6 +++ Widget.chs 27 Mar 2005 12:51:38 -0000 1.7 @@ -29,13 +29,12 @@ -- widgetModifyStyle, widgetGetModifierStyle, widgetModifyFg, -- widgetModifyBG, widgetModifyText, widgetModifyBase, widgetModifyFont, -- widgetPango*, widgetSetAdjustments --- -- -- implement the following methods in GtkWindow object: -- widget_set_uposition, widget_set_usize -- -- implement the following methods in GtkDrawingArea object: --- widgetQueueDrawArea, widgetSetDoubleBufferd, widgetRegionIntersect +-- widgetRegionIntersect -- -- | -- Maintainer : gtk...@li... @@ -108,6 +107,9 @@ TextDirection(..), widgetSetDirection, -- General Setup. widgetGetDirection, + widgetQueueDrawArea, + widgetSetDoubleBuffered, + widgetSetRedrawOnAllocate, -- * Properties widgetExtensionEvents, @@ -206,199 +208,422 @@ -------------------- -- Methods --- | Queue a show request. --- --- * Flags a widget to be displayed. Any widget that isn't shown will not --- appear on the screen. If you want to show all the widgets in a container, --- it's easier to call 'widgetShowAll' on the container, instead --- of individually showing the widgets. Note that you have to show the --- containers containing a widget, in addition to the widget itself, before --- it will appear onscreen. When a toplevel container is shown, it is --- immediately realized and mapped; other shown widgets are realized and --- mapped when their toplevel container is realized and mapped. +-- | Flags a widget to be displayed. Any widget that isn't shown will not +-- appear on the screen. If you want to show all the widgets in a container, +-- it's easier to call 'widgetShowAll' on the container, instead of +-- individually showing the widgets. -- -widgetShow :: WidgetClass w => w -> IO () -widgetShow = {#call widget_show#}.toWidget - --- | Queue a show event and wait for it to be executed. +-- Remember that you have to show the containers containing a widget, in +-- addition to the widget itself, before it will appear onscreen. -- --- * If the widget is an unmapped toplevel widget (i.e. a 'Window' --- that has not yet been shown), enter the main loop and wait for the window --- to actually be mapped. Be careful; because the main loop is running, --- anything can happen during this function. +-- When a toplevel container is shown, it is immediately realized and +-- mapped; other shown widgets are realized and mapped when their toplevel +-- container is realized and mapped. -- -widgetShowNow :: WidgetClass w => w -> IO () -widgetShowNow = {#call widget_show_now#}.toWidget +widgetShow :: WidgetClass self => self -> IO () +widgetShow self = + {# call widget_show #} + (toWidget self) --- | Queue a hide request. +-- | Shows a widget. If the widget is an unmapped toplevel widget (i.e. a +-- 'Window' that has not yet been shown), enter the main loop and wait for the +-- window to actually be mapped. Be careful; because the main loop is running, +-- anything can happen during this function. -- --- * Reverses the effects of 'widgetShow', causing the widget to be --- hidden (make invisible to the user). +widgetShowNow :: WidgetClass self => self -> IO () +widgetShowNow self = + {# call widget_show_now #} + (toWidget self) + +-- | Reverses the effects of 'widgetShow', causing the widget to be hidden +-- (invisible to the user). -- -widgetHide :: WidgetClass w => w -> IO () -widgetHide = {#call widget_hide#}.toWidget +widgetHide :: WidgetClass self => self -> IO () +widgetHide self = + {# call widget_hide #} + (toWidget self) --- | Show this and all child widgets. +-- | Recursively shows a widget, and any child widgets (if the widget is a +-- container). -- -widgetShowAll :: WidgetClass w => w -> IO () -widgetShowAll = {#call widget_show_all#}.toWidget +widgetShowAll :: WidgetClass self => self -> IO () +widgetShowAll self = + {# call widget_show_all #} + (toWidget self) --- | Hide this and all child widgets. +-- | Recursively hides a widget and any child widgets. -- -widgetHideAll :: WidgetClass w => w -> IO () -widgetHideAll = {#call widget_hide_all#}.toWidget +widgetHideAll :: WidgetClass self => self -> IO () +widgetHideAll self = + {# call widget_hide_all #} + (toWidget self) --- | Destroy a widget. +-- | Destroys a widget. Equivalent to 'objectDestroy'. -- --- * The 'widgetDestroy' function is used to shutdown an object, --- i.e. a widget will be removed from the screen and unrealized. Resources --- will be freed when all references are released. +-- When a widget is destroyed it will be removed from the screen and +-- unrealized. When a widget is destroyed, it will break any references it +-- holds to other objects.If the widget is inside a container, the widget will +-- be removed from the container. The widget will be garbage collected +-- (finalized) time after your last reference to the widget dissapears. -- -widgetDestroy :: WidgetClass obj => obj -> IO () -widgetDestroy = {#call widget_destroy#}.toWidget +-- In most cases, only toplevel widgets (windows) require explicit +-- destruction, because when you destroy a toplevel its children will be +-- destroyed as well. +-- +widgetDestroy :: WidgetClass self => self -> IO () +widgetDestroy self = + {# call widget_destroy #} + (toWidget self) -- Functions to be used with DrawingArea. -- | Prepare text for display. -- --- * The 'Layout' represents the rendered text. It can be shown on --- screen by calling 'drawLayout'. +-- The 'PangoLayout' represents the rendered text. It can be shown on screen +-- by calling 'drawLayout'. +-- +-- The returned 'Layout' shares the same font information ('Context') as this +-- widget. If this information changes, the 'Layout' should change. The +-- following code ensures that the displayed text always reflects the widget's +-- settings: -- --- * The returned 'Layout' shares the same font information --- ('Context') as this widget. If this information changes, --- the 'Layout' should change. The following code ensures that --- the displayed text always reflects the widget's settings: --- -- > l <- widgetCreateLayout w "My Text." -- > let update = do -- > layoutContextChanged l --- > <update the Drawables which show this layout> +-- > -- update the Drawables which show this layout -- > w `onDirectionChanged` update -- > w `onStyleChanged` update -- -widgetCreateLayout :: WidgetClass obj => obj -> String -> IO PangoLayout -widgetCreateLayout obj txt = withUTFString txt $ - \strPtr -> makeNewGObject mkPangoLayout - ({#call unsafe widget_create_pango_layout#} (toWidget obj) strPtr) - --- | Send a redraw request to a widget. +widgetCreateLayout :: WidgetClass self => self + -> String -- ^ @text@ - text to set on the layout + -> IO PangoLayout +widgetCreateLayout self text = + makeNewGObject mkPangoLayout $ + withUTFString text $ \textPtr -> + {# call unsafe widget_create_pango_layout #} + (toWidget self) + textPtr + +-- | Send a redraw request to a widget. Equivalent to calling +-- 'widgetQueueDrawArea' for the entire area of a widget. -- -widgetQueueDraw :: WidgetClass w => w -> IO () -widgetQueueDraw = {#call widget_queue_draw#}.toWidget +widgetQueueDraw :: WidgetClass self => self -> IO () +widgetQueueDraw self = + {# call widget_queue_draw #} + (toWidget self) --- | Check if the widget intersects with a given --- area. +-- | Check if the widget intersects with a given area. -- -widgetHasIntersection :: WidgetClass w => w -> Rectangle -> IO Bool -widgetHasIntersection w r = +widgetHasIntersection :: WidgetClass self => self + -> Rectangle -- ^ @area@ - a rectangle + -> IO Bool -- ^ returns @True@ if there was an intersection +widgetHasIntersection self area = liftM toBool $ - withObject r $ \r' -> - {#call unsafe widget_intersect#} (toWidget w) (castPtr r') (castPtr nullPtr) + withObject area $ \areaPtr -> + {# call unsafe widget_intersect #} + (toWidget self) + (castPtr areaPtr) + (castPtr nullPtr) -- Manipulate widget state. --- | Activate the widget (e.g. clicking a button). +-- | For widgets that can be \"activated\" (buttons, menu items, etc.) this +-- function activates them. Activation is what happens when you press Enter on +-- a widget during key navigation. If @widget@ isn't activatable, the function +-- returns @False@. -- -widgetActivate :: WidgetClass w => w -> IO Bool -widgetActivate w = liftM toBool $ {#call widget_activate#} (toWidget w) +widgetActivate :: WidgetClass self => self + -> IO Bool -- ^ returns @True@ if the widget was activatable +widgetActivate self = + liftM toBool $ + {# call widget_activate #} + (toWidget self) --- | Set the widgets sensitivity (Grayed or --- Usable). +-- | Sets the sensitivity of a widget. A widget is sensitive if the user can +-- interact with it. Insensitive widgets are \"grayed out\" and the user can't +-- interact with them. Insensitive widgets are known as \"inactive\", +-- \"disabled\", or \"ghosted\" in some other toolkits. -- -widgetSetSensitivity :: WidgetClass w => w -> Bool -> IO () -widgetSetSensitivity w b = - {#call widget_set_sensitive#} (toWidget w) (fromBool b) +widgetSetSensitivity :: WidgetClass self => self + -> Bool -- ^ @sensitive@ - @True@ to make the widget sensitive + -> IO () +widgetSetSensitivity self sensitive = + {# call widget_set_sensitive #} + (toWidget self) + (fromBool sensitive) --- | Sets the minimum size of a widget. +-- | Sets the minimum size of a widget; that is, the widget's size request +-- will be @width@ by @height@. You can use this function to force a widget to +-- be either larger or smaller than it normally would be. -- -widgetSetSizeRequest :: WidgetClass w => w -> Int -> Int -> IO () -widgetSetSizeRequest w width height = - {#call widget_set_size_request#} (toWidget w) (fromIntegral width) (fromIntegral height) +-- In most cases, 'windowSetDefaultSize' is a better choice for toplevel +-- windows than this function; setting the default size will still allow users +-- to shrink the window. Setting the size request will force them to leave the +-- window at least as large as the size request. When dealing with window +-- sizes, 'windowSetGeometryHints' can be a useful function as well. +-- +-- Note the inherent danger of setting any fixed size - themes, translations +-- into other languages, different fonts, and user action can all change the +-- appropriate size for a given widget. So, it's basically impossible to +-- hardcode a size that will always be correct. +-- +-- The size request of a widget is the smallest size a widget can accept +-- while still functioning well and drawing itself correctly. However in some +-- strange cases a widget may be allocated less than its requested size, and in +-- many cases a widget may be allocated more space than it requested. +-- +-- If the size request in a given direction is -1 (unset), then the +-- \"natural\" size request of the widget will be used instead. +-- +-- Widgets can't actually be allocated a size less than 1 by 1, but you can +-- pass 0,0 to this function to mean \"as small as possible.\" +-- +widgetSetSizeRequest :: WidgetClass self => self + -> Int -- ^ @width@ - width @widget@ should request, or -1 to unset + -> Int -- ^ @height@ - height @widget@ should request, or -1 to unset + -> IO () +widgetSetSizeRequest self width height = + {# call widget_set_size_request #} + (toWidget self) + (fromIntegral width) + (fromIntegral height) --- | Set and query the input focus of a widget. +-- | Determines if the widget is the focus widget within its toplevel. -- -widgetIsFocus :: WidgetClass w => w -> IO Bool -widgetIsFocus w = liftM toBool $ - {#call unsafe widget_is_focus#} (toWidget w) +widgetIsFocus :: WidgetClass self => self + -> IO Bool -- ^ returns @True@ if the widget is the focus widget. +widgetIsFocus self = + liftM toBool $ + {# call unsafe widget_is_focus #} + (toWidget self) -widgetGrabFocus :: WidgetClass w => w -> IO () -widgetGrabFocus = {#call widget_grab_focus#}.toWidget +-- | Causes the widget to have the keyboard focus for the 'Window' it's inside. +-- The widget must be a focusable widget, such as a 'Entry'; something like +-- 'Frame' won't work. (More precisely, it must have the 'CanFocus' flag set.) +-- +widgetGrabFocus :: WidgetClass self => self -> IO () +widgetGrabFocus self = + {# call widget_grab_focus #} + (toWidget self) -- | Sets some weired flag in the widget. -- -widgetSetAppPaintable :: WidgetClass w => w -> Bool -> IO () -widgetSetAppPaintable w p = - {#call widget_set_app_paintable#} (toWidget w) (fromBool p) +widgetSetAppPaintable :: WidgetClass self => self + -> Bool -- ^ @appPaintable@ - + -> IO () +widgetSetAppPaintable self appPaintable = + {# call widget_set_app_paintable #} + (toWidget self) + (fromBool appPaintable) --- | Set the name of a widget. +-- | Widgets can be named, which allows you to refer to them from a gtkrc +-- file. You can apply a style to widgets with a particular name in the gtkrc +-- file. See the documentation for gtkrc files. -- -widgetSetName :: WidgetClass w => w -> String -> IO () -widgetSetName w name = - withUTFString name ({#call widget_set_name#} (toWidget w)) +-- Note that widget names are separated by periods in paths (see +-- 'widgetPath'), so names with embedded periods may cause confusion. +-- +widgetSetName :: WidgetClass self => self + -> String -- ^ @name@ - name for the widget + -> IO () +widgetSetName self name = + withUTFString name $ \namePtr -> + {# call widget_set_name #} + (toWidget self) + namePtr --- | Get the name of a widget. +-- | Retrieves the name of a widget. See 'widgetSetName' for the significance +-- of widget names. -- -widgetGetName :: WidgetClass w => w -> IO String -widgetGetName w = {#call unsafe widget_get_name#} (toWidget w) >>= - peekUTFString +widgetGetName :: WidgetClass self => self + -> IO String +widgetGetName self = + {# call unsafe widget_get_name #} + (toWidget self) + >>= peekUTFString -- | Enable event signals. -- -widgetAddEvents :: WidgetClass w => w -> [EventMask] -> IO () -widgetAddEvents w em = - {#call widget_add_events#} (toWidget w) (fromIntegral $ fromFlags em) +widgetAddEvents :: WidgetClass self => self -> [EventMask] -> IO () +widgetAddEvents self events = + {# call widget_add_events #} + (toWidget self) + (fromIntegral $ fromFlags events) --- | Get enabled event signals. +-- | Get enabled event signals. These are the events that the widget will +-- receive. -- -widgetGetEvents :: WidgetClass w => w -> IO [EventMask] -widgetGetEvents w = liftM (toFlags.fromIntegral) $ - {#call unsafe widget_get_events#} (toWidget w) +widgetGetEvents :: WidgetClass self => self -> IO [EventMask] +widgetGetEvents self = + liftM (toFlags . fromIntegral) $ + {# call unsafe widget_get_events #} + (toWidget self) --- | Set extension events. +-- | Sets the extension events. -- -widgetSetExtensionEvents :: WidgetClass w => w -> [ExtensionMode] -> IO () -widgetSetExtensionEvents w em = - {#call widget_set_extension_events#} (toWidget w) - (fromIntegral $ fromFlags em) +widgetSetExtensionEvents :: WidgetClass self => self + -> [ExtensionMode] + -> IO () +widgetSetExtensionEvents self mode = + {# call widget_set_extension_events #} + (toWidget self) + ((fromIntegral . fromFlags) mode) --- | Get extension events. +-- | Retrieves the extension events the widget will receive; see +-- 'inputSetExtensionEvents'. -- -widgetGetExtensionEvents :: WidgetClass w => w -> IO [ExtensionMode] -widgetGetExtensionEvents w = liftM (toFlags.fromIntegral) $ - {#call widget_get_extension_events#} (toWidget w) +widgetGetExtensionEvents :: WidgetClass self => self + -> IO [ExtensionMode] +widgetGetExtensionEvents self = + liftM (toFlags . fromIntegral) $ + {# call widget_get_extension_events #} + (toWidget self) -- Widget browsing. --- | Retrieves the topmost widget in this tree. +-- | This function returns the topmost widget in the container hierarchy +-- @widget@ is a part of. If @widget@ has no parent widgets, it will be +-- returned as the topmost widget. -- -widgetGetToplevel :: WidgetClass w => w -> IO Widget -widgetGetToplevel w = makeNewObject mkWidget $ - {#call unsafe widget_get_toplevel#} (toWidget w) +widgetGetToplevel :: WidgetClass self => + self -- ^ @widget@ - the widget in question + -> IO Widget -- ^ returns the topmost ancestor of @widget@, or @widget@ + -- itself if there's no ancestor. +widgetGetToplevel self = + makeNewObject mkWidget $ + {# call unsafe widget_get_toplevel #} + (toWidget self) --- | Return True if the second widget is (possibly --- indirectly) held by the first. +-- | Determines whether @widget@ is somewhere inside @ancestor@, possibly with +-- intermediate containers. -- -widgetIsAncestor :: (WidgetClass w, WidgetClass anc) => anc -> w -> IO Bool -widgetIsAncestor anc w = liftM toBool $ - {#call unsafe widget_is_ancestor#} (toWidget w) (toWidget anc) +widgetIsAncestor :: (WidgetClass self, WidgetClass ancestor) => + self -- ^ @widget@ - the widget in question + -> ancestor -- ^ @ancestor@ - another 'Widget' + -> IO Bool -- ^ returns @True@ if @ancestor@ contains @widget@ as a child, + -- grandchild, great grandchild, etc. +widgetIsAncestor self ancestor = + liftM toBool $ + {# call unsafe widget_is_ancestor #} + (toWidget self) + (toWidget ancestor) --- | Move a widget to a new parent. +-- | Moves a widget from one 'Container' to another. -- -widgetReparent :: (WidgetClass w, WidgetClass par) => w -> par -> IO () -widgetReparent w par = - {#call widget_reparent#} (toWidget w) (toWidget par) +widgetReparent :: (WidgetClass self, WidgetClass newParent) => self + -> newParent -- ^ @newParent@ - a 'Container' to move the widget into + -> IO () +widgetReparent self newParent = + {# call widget_reparent #} + (toWidget self) + (toWidget newParent) --- | Setting packaging and writing direction. +-- | Sets the reading direction on a particular widget. This direction +-- controls the primary direction for widgets containing text, and also the +-- direction in which the children of a container are packed. The ability to +-- set the direction is present in order so that correct localization into +-- languages with right-to-left reading directions can be done. Generally, +-- applications will let the default reading direction present, except for +-- containers where the containers are arranged in an order that is explicitely +-- visual rather than logical (such as buttons for text justification). -- -widgetSetDirection :: WidgetClass w => w -> TextDirection -> IO () -widgetSetDirection w td = - {#call widget_set_direction#} (toWidget w) ((fromIntegral.fromEnum) td) +-- If the direction is set to 'TextDirNone', then the value set by +-- 'widgetSetDefaultDirection' will be used. +-- +widgetSetDirection :: WidgetClass self => self + -> TextDirection + -> IO () +widgetSetDirection self dir = + {# call widget_set_direction #} + (toWidget self) + ((fromIntegral . fromEnum) dir) --- | Retrieve the default direction of text writing. +-- | Gets the reading direction for a particular widget. See +-- 'widgetSetDirection'. -- -widgetGetDirection :: WidgetClass w => w -> IO TextDirection -widgetGetDirection w = liftM (toEnum.fromIntegral) $ - {#call widget_get_direction#} (toWidget w) +widgetGetDirection :: WidgetClass self => self + -> IO TextDirection +widgetGetDirection self = + liftM (toEnum . fromIntegral) $ + {# call widget_get_direction #} + (toWidget self) + +-- | Invalidates the rectangular area of @widget@ defined by @x@, @y@, @width@ +-- and @height@ by calling 'windowInvalidateRect' on the widget's window and +-- all its child windows. Once the main loop becomes idle (after the current +-- batch of events has been processed, roughly), the window will receive expose +-- events for the union of all regions that have been invalidated. +-- +-- Normally you would only use this function in widget implementations. You +-- might also use it, or 'windowInvalidateRect' directly, to schedule a redraw +-- of a 'DrawingArea' or some portion thereof. +-- +-- Frequently you can just call 'windowInvalidateRect' or +-- 'windowInvalidateRegion' instead of this function. Those functions will +-- invalidate only a single window, instead of the widget and all its children. +-- +-- The advantage of adding to the invalidated region compared to simply +-- drawing immediately is efficiency; using an invalid region ensures that you +-- only have to redraw one time. +-- +widgetQueueDrawArea :: WidgetClass self => self + -> Int -- ^ @x@ - x coordinate of upper-left corner of rectangle to redraw + -> Int -- ^ @y@ - y coordinate of upper-left corner of rectangle to redraw + -> Int -- ^ @width@ - width of region to draw + -> Int -- ^ @height@ - height of region to draw + -> IO () +widgetQueueDrawArea self x y width height = + {# call gtk_widget_queue_draw_area #} + (toWidget self) + (fromIntegral x) + (fromIntegral y) + (fromIntegral width) + (fromIntegral height) + +-- | Widgets are double buffered by default; you can use this function to turn +-- off the buffering. \"Double buffered\" simply means that +-- 'windowBeginPaintRegion' and 'windowEndPaint' are called automatically +-- around expose events sent to the widget. 'windowBeginPaint' diverts all +-- drawing to a widget's window to an offscreen buffer, and 'windowEndPaint' +-- draws the buffer to the screen. The result is that users see the window +-- update in one smooth step, and don't see individual graphics primitives +-- being rendered. +-- +-- In very simple terms, double buffered widgets don't flicker, so you would +-- only use this function to turn off double buffering if you had special needs +-- and really knew what you were doing. +-- +widgetSetDoubleBuffered :: WidgetClass self => self + -> Bool -- ^ @doubleBuffered@ - @True@ to double-buffer a widget + -> IO () +widgetSetDoubleBuffered self doubleBuffered = + {# call gtk_widget_set_double_buffered #} + (toWidget self) + (fromBool doubleBuffered) + +-- | Sets whether when a widgets size allocation changes, the entire widget +-- is queued for drawing. By default, this setting is @True@ and the entire +-- widget is redrawn on every size change. If your widget leaves the upper left +-- unchanged when made bigger, turning this setting on will improve +-- performance. +-- +-- Note that for \"no window\" widgets setting this flag to @False@ turns off +-- all allocation on resizing: the widget will not even redraw if its position +-- changes; this is to allow containers that don't draw anything to avoid +-- excess invalidations. If you set this flag on a \"no window\" widget that +-- /does/ draw its window, you are responsible for invalidating both +-- the old and new allocation of the widget when the widget is moved and +-- responsible for invalidating regions newly when the widget increases size. +-- +widgetSetRedrawOnAllocate :: WidgetClass self => self + -> Bool -- ^ @redrawOnAllocate@ - if @True@, the entire widget will be + -- redrawn when it is allocated to a new size. Otherwise, only the + -- new portion of the widget will be redrawn. + -> IO () +widgetSetRedrawOnAllocate self redrawOnAllocate = + {# call gtk_widget_set_redraw_on_allocate #} + (toWidget self) + (fromBool redrawOnAllocate) -------------------- -- Properties |
|
From: Duncan C. <dun...@us...> - 2005-03-27 11:55:04
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Abstract In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8898/gtk/Graphics/UI/Gtk/Abstract Modified Files: Container.chs Log Message: more merging from the auto-generated code: container.chs: documentation changes and code formattign changes. Also added a few extra functions and a couple properties. Window.chs.pp: added bindings for 22 extra functions (most of which are probably useful!). Index: Container.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Abstract/Container.chs,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Container.chs 25 Feb 2005 22:53:40 -0000 1.4 +++ Container.chs 27 Mar 2005 11:54:52 -0000 1.5 @@ -24,11 +24,10 @@ -- Stability : provisional -- Portability : portable (depends on GHC) -- --- This abstract widget implements the basis for turning serveral widgets --- into one compound widget. +-- Base class for widgets which contain other widgets -- module Graphics.UI.Gtk.Abstract.Container ( --- * Description +-- * Detail -- -- | A Gtk+ user interface is constructed by nesting widgets inside widgets. -- Container widgets are the inner nodes in the resulting tree of widgets: they @@ -118,6 +117,7 @@ -- | +----'CList' -- | +----'Fixed' -- | +----'Paned' +-- | +----'IconView' -- | +----'Layout' -- | +----'List' -- | +----'MenuShell' @@ -138,6 +138,7 @@ containerAdd, containerRemove, containerForeach, + containerForall, containerGetChildren, DirectionType(..), containerSetFocusChild, @@ -151,9 +152,15 @@ containerResizeChildren, containerSetBorderWidth, containerGetBorderWidth, + containerGetResizeMode, + containerSetResizeMode, containerChildSetProperty, containerChildGetProperty, +-- * Properties + containerResizeMode, + containerBorderWidth, + -- * Signals onAdd, afterAdd, @@ -171,46 +178,63 @@ import System.Glib.FFI import System.Glib.UTFString +import System.Glib.Attributes (Attr(..)) import System.Glib.GObject (objectRef, objectUnref) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import System.Glib.GList (fromGList, toGList) {#import System.Glib.GValue#} (GValue, GenericValue, valueUnset) -import Graphics.UI.Gtk.General.Enums (DirectionType(..)) +import Graphics.UI.Gtk.General.Enums (DirectionType(..), ResizeMode(..)) {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods --- | Add a widget to the container. --- --- * Only useful for simple --- containers like Window. Use boxPackStart or tableAttach in other cases. A --- widget may not be added to more than one container. +-- | Adds @widget@ to the container. Typically used for simple containers such +-- as 'Window', 'Frame', or 'Button'; for more complicated layout containers +-- such as 'Box' or 'Table', this function will pick default packing parameters +-- that may not be correct. So consider functions such as 'boxPackStart' and +-- 'tableAttach' as an alternative to 'containerAdd' in those cases. A widget +-- may be added to only one container at a time; you can't place the same +-- widget inside two different containers. -- -containerAdd :: (ContainerClass c, WidgetClass w) => c -> w -> IO () -containerAdd con widget = - {#call container_add#} (toContainer con) (toWidget widget) - +containerAdd :: (ContainerClass self, WidgetClass widget) => self + -> widget -- ^ @widget@ - a widget to be placed inside @container@ + -> IO () +containerAdd self widget = + {# call container_add #} + (toContainer self) + (toWidget widget) --- | Removes a present widget from the container. +-- | Removes @widget@ from @container@. @widget@ must be inside @container@. -- -containerRemove :: (ContainerClass c, WidgetClass w) => c -> w -> IO () -containerRemove con widget = - {#call container_remove#} (toContainer con) (toWidget widget) - +containerRemove :: (ContainerClass self, WidgetClass widget) => self + -> widget -- ^ @widget@ - a current child of @container@ + -> IO () +containerRemove self widget = + {# call container_remove #} + (toContainer self) + (toWidget widget) --- | Do something for each widget in the container. +-- | Maps @callback@ over each non-internal child of @container@. See +-- 'containerForall' for details on what constitutes an \"internal\" child. +-- Most applications should use 'containerForeach', rather than +-- 'containerForall'. -- -containerForeach :: ContainerClass c => c -> ContainerForeachCB -> IO () -containerForeach con fun = do +containerForeach :: ContainerClass self => self + -> ContainerForeachCB + -> IO () +containerForeach self fun = do fPtr <- mkContainerForeachFunc (\wPtr _ -> do objectRef wPtr w <- liftM mkWidget $ newForeignPtr wPtr (objectUnref wPtr) fun w) - {#call container_foreach#} (toContainer con) fPtr nullPtr + {# call container_foreach #} + (toContainer self) + fPtr + nullPtr freeHaskellFunPtr fPtr type ContainerForeachCB = Widget -> IO () @@ -219,29 +243,64 @@ foreign import ccall "wrapper" mkContainerForeachFunc :: (Ptr Widget -> Ptr () -> IO ()) -> IO Callback --- | Returns the the container's children. +-- | Maps @callback@ over each child of @container@, including children that +-- are considered \"internal\" (implementation details of the container). +-- \"Internal\" children generally weren't added by the user of the container, +-- but were added by the container implementation itself. Most applications +-- should use 'containerForeach', rather than 'containerForall'. -- -containerGetChildren :: ContainerClass c => c -> IO [Widget] -containerGetChildren con = do - glist <- {#call container_get_children#} (toContainer con) +containerForall :: ContainerClass self => self + -> ContainerForeachCB -- ^ @callback@ - a callback + -> IO () +containerForall self fun = do + fPtr <- mkContainerForeachFunc (\wPtr _ -> do + objectRef wPtr + w <- liftM mkWidget $ newForeignPtr wPtr (objectUnref wPtr) + fun w) + {# call container_forall #} + (toContainer self) + fPtr + nullPtr + freeHaskellFunPtr fPtr + +-- | Returns the the container's non-internal children. See 'containerForall' +-- for details on what constitutes an \"internal\" child. +-- +containerGetChildren :: ContainerClass self => self + -> IO [Widget] +containerGetChildren self = do + glist <- {# call container_get_children #} (toContainer self) widgetPtrs <- fromGList glist mapM (makeNewObject mkWidget . return) widgetPtrs --- | Give the focus to a specific child of the --- container. +-- | Give the focus to a specific child of the container. -- -containerSetFocusChild :: (ContainerClass c, WidgetClass w) => c -> w -> IO () -containerSetFocusChild con widget = - {#call container_set_focus_child#} (toContainer con) (toWidget widget) +containerSetFocusChild :: (ContainerClass self, WidgetClass child) => self + -> child -- ^ @child@ + -> IO () +containerSetFocusChild self child = + {# call container_set_focus_child #} + (toContainer self) + (toWidget child) --- | Sets a focus chain, overriding the one computed automatically by GTK+. +-- | Sets a focus chain, overriding the one computed automatically by Gtk+. -- -containerSetFocusChain :: ContainerClass c => c -> [Widget] -> IO () -containerSetFocusChain con chain = +-- In principle each widget in the chain should be a descendant of the +-- container, but this is not enforced by this method, since it's allowed to +-- set the focus chain before you pack the widgets, or have a widget in the +-- chain that isn't always packed. The necessary checks are done when the focus +-- chain is actually traversed. +-- +containerSetFocusChain :: ContainerClass self => self + -> [Widget] -- ^ @focusableWidgets@ - the new focus chain. + -> IO () +containerSetFocusChain self chain = let wForeignPtrs = map (\w -> case toWidget w of Widget ptr -> ptr) chain in withForeignPtrs wForeignPtrs $ \wPtrs -> do glist <- toGList wPtrs - {#call container_set_focus_chain#} (toContainer con) glist + {# call container_set_focus_chain #} + (toContainer self) + glist withForeignPtrs :: [ForeignPtr a] -> ([Ptr a] -> IO b) -> IO b withForeignPtrs = withForeignPtrs' [] @@ -249,12 +308,18 @@ withForeignPtrs' accum (p:ps) cont = withForeignPtr p $ \p' -> withForeignPtrs' (p':accum) ps cont --- | Retrieves the focus chain of the container, if one has been set explicitly. +-- | Retrieves the focus chain of the container, if one has been set +-- explicitly. If no focus chain has been explicitly set, Gtk+ computes the +-- focus chain based on the positions of the children. In that case the +-- function returns @Nothing@. -- -containerGetFocusChain :: ContainerClass c => c -> IO (Maybe [Widget]) -containerGetFocusChain con = +containerGetFocusChain :: ContainerClass self => self + -> IO (Maybe [Widget]) +containerGetFocusChain self = alloca $ \glistPtr -> do - {#call container_get_focus_chain#} (toContainer con) glistPtr + {# call container_get_focus_chain #} + (toContainer self) + glistPtr if glistPtr == nullPtr then return Nothing else liftM Just $ do glist <- peek glistPtr widgetPtrs <- fromGList glist @@ -262,110 +327,204 @@ -- | Removes a focus chain explicitly set with 'containerSetFocusChain'. -- -containerUnsetFocusChain :: ContainerClass c => c -> IO () -containerUnsetFocusChain con = - {#call container_unset_focus_chain#} (toContainer con) +containerUnsetFocusChain :: ContainerClass self => self -> IO () +containerUnsetFocusChain self = + {# call container_unset_focus_chain #} + (toContainer self) --- | Install an adjustment widget that is queried when focus is changed. +-- | Hooks up an adjustment to focus handling in a container, so when a child +-- of the container is focused, the adjustment is scrolled to show that widget. +-- This function sets the vertical alignment. See +-- 'scrolledWindowGetVAdjustment' for a typical way of obtaining the adjustment +-- and 'containerSetFocusHAdjustment' for setting the horizontal adjustment. -- -containerSetFocusVAdjustment :: (ContainerClass c, AdjustmentClass a) => c -> - a -> IO () -containerSetFocusVAdjustment con adj = - {#call container_set_focus_vadjustment#} (toContainer con) (toAdjustment adj) +-- The adjustments have to be in pixel units and in the same coordinate +-- system as the allocation for immediate children of the container. +-- +containerSetFocusVAdjustment :: ContainerClass self => self + -> Adjustment -- ^ @adjustment@ - an adjustment which should be adjusted when + -- the focus is moved among the descendents of @container@ + -> IO () +containerSetFocusVAdjustment self adjustment = + {# call container_set_focus_vadjustment #} + (toContainer self) + adjustment --- | Retrieves the vertical focus adjustment for the container, or Nothing if --- none has been set. +-- | Retrieves the vertical focus adjustment for the container. See +-- 'containerSetFocusVAdjustment'. -- -containerGetFocusVAdjustment :: ContainerClass c => c -> IO (Maybe Adjustment) -containerGetFocusVAdjustment con = do - aPtr <- {#call unsafe container_get_focus_vadjustment#} (toContainer con) - if aPtr==nullPtr then return Nothing else liftM Just $ - makeNewObject mkAdjustment (return aPtr) +containerGetFocusVAdjustment :: ContainerClass self => self + -> IO (Maybe Adjustment) -- ^ returns the vertical focus adjustment, or + -- @Nothing@ if none has been set. +containerGetFocusVAdjustment self = + maybeNull (makeNewObject mkAdjustment) $ + {# call unsafe container_get_focus_vadjustment #} + (toContainer self) --- | Install an adjustment widget that is queried when focus is changed. +-- | Hooks up an adjustment to focus handling in a container, so when a child +-- of the container is focused, the adjustment is scrolled to show that widget. +-- This function sets the horizontal alignment. See +-- 'scrolledWindowGetHAdjustment' for a typical way of obtaining the adjustment +-- and 'containerSetFocusVAdjustment' for setting the vertical adjustment. -- -containerSetFocusHAdjustment :: (ContainerClass c, AdjustmentClass a) => c -> - a -> IO () -containerSetFocusHAdjustment con adj = - {#call container_set_focus_hadjustment#} (toContainer con) (toAdjustment adj) +-- The adjustments have to be in pixel units and in the same coordinate +-- system as the allocation for immediate children of the container. +-- +containerSetFocusHAdjustment :: ContainerClass self => self + -> Adjustment -- ^ @adjustment@ - an adjustment which should be adjusted when + -- the focus is moved among the descendents of @container@ + -> IO () +containerSetFocusHAdjustment self adjustment = + {# call container_set_focus_hadjustment #} + (toContainer self) + adjustment --- | Retrieves the horizontal focus adjustment for the container, or Nothing if --- none has been set. +-- | Retrieves the horizontal focus adjustment for the container. See +-- 'containerSetFocusHAdjustment'. -- -containerGetFocusHAdjustment :: ContainerClass c => c -> IO (Maybe Adjustment) -containerGetFocusHAdjustment con = do - aPtr <- {#call unsafe container_get_focus_hadjustment#} (toContainer con) - if aPtr==nullPtr then return Nothing else liftM Just $ - makeNewObject mkAdjustment (return aPtr) +containerGetFocusHAdjustment :: ContainerClass self => self + -> IO (Maybe Adjustment) -- ^ returns the horizontal focus adjustment, or + -- @Nothing@ if none has been set. +containerGetFocusHAdjustment self = + maybeNull (makeNewObject mkAdjustment) $ + {# call unsafe container_get_focus_hadjustment #} + (toContainer self) -- | Make the container resize its children. -- -containerResizeChildren :: ContainerClass c => c -> IO () -containerResizeChildren con = - {#call container_resize_children#} (toContainer con) +containerResizeChildren :: ContainerClass self => self -> IO () +containerResizeChildren self = + {# call container_resize_children #} + (toContainer self) --- | Set the amount of empty space around the outside of the container. +-- | Sets the border width of the container. -- --- The border width of a container is the amount of space to leave around the --- outside of the container. The border is added on all sides of the container. +-- The border width of a container is the amount of space to leave around +-- the outside of the container. The only exception to this is 'Window'; +-- because toplevel windows can't leave space outside, they leave the space +-- inside. The border is added on all sides of the container. To add space to +-- only one side, one approach is to create a 'Alignment' widget, call +-- 'widgetSetUsize' to give it a size, and place it on the side of the +-- container as a spacer. -- -containerSetBorderWidth :: ContainerClass c => c -> Int -> IO () -containerSetBorderWidth con width = - {#call container_set_border_width#} (toContainer con) (fromIntegral width) +containerSetBorderWidth :: ContainerClass self => self + -> Int -- ^ @borderWidth@ - amount of blank space to leave /outside/ the + -- container. Valid values are in the range 0-65535 pixels. + -> IO () +containerSetBorderWidth self borderWidth = + {# call container_set_border_width #} + (toContainer self) + (fromIntegral borderWidth) --- | Retrieves the border width of the container. See 'containerSetBorderWidth'. +-- | Retrieves the border width of the container. See +-- 'containerSetBorderWidth'. -- -containerGetBorderWidth :: ContainerClass c => c -> IO Int -containerGetBorderWidth con = liftM fromIntegral $ - {#call unsafe container_get_border_width#} (toContainer con) +containerGetBorderWidth :: ContainerClass self => self + -> IO Int -- ^ returns the current border width +containerGetBorderWidth self = + liftM fromIntegral $ + {# call unsafe container_get_border_width #} + (toContainer self) + +-- | Returns the resize mode for the container. See 'containerSetResizeMode'. +-- +containerGetResizeMode :: ContainerClass self => self + -> IO ResizeMode -- ^ returns the current resize mode +containerGetResizeMode self = + liftM (toEnum . fromIntegral) $ + {# call gtk_container_get_resize_mode #} + (toContainer self) + +-- | Sets the resize mode for the container. +-- +-- The resize mode of a container determines whether a resize request will +-- be passed to the container's parent, queued for later execution or executed +-- immediately. +-- +containerSetResizeMode :: ContainerClass self => self + -> ResizeMode -- ^ @resizeMode@ - the new resize mode. + -> IO () +containerSetResizeMode self resizeMode = + {# call gtk_container_set_resize_mode #} + (toContainer self) + ((fromIntegral . fromEnum) resizeMode) -- TODO add doc on what child properties are --- | Sets a child property for child and container. +-- | Sets a child property for @child@ and the container. -- -containerChildSetProperty :: (ContainerClass c, WidgetClass widget) => c - -> widget -- ^ Chile widget - -> String -- ^ Property name - -> GenericValue -- ^ Property value - -> IO () -containerChildSetProperty con child prop val = - alloca $ \valPtr -> - withUTFString prop $ \strPtr -> do - poke valPtr val - {#call container_child_set_property#} (toContainer con) - (toWidget child) strPtr valPtr +containerChildSetProperty :: (ContainerClass self, WidgetClass child) => self + -> child -- ^ @child@ - a widget which is a child of the container + -> String -- ^ @propertyName@ - the name of the property to set + -> GenericValue -- ^ @value@ - the value to set the property to + -> IO () +containerChildSetProperty self child propertyName value = + alloca $ \valuePtr -> + withUTFString propertyName $ \propertyNamePtr -> do + poke valuePtr value + {# call container_child_set_property #} + (toContainer self) + (toWidget child) + propertyNamePtr + valuePtr --- | Gets the value of a child property for the given child and container. +-- | Gets the value of a child property for @child@ and the container. -- -containerChildGetProperty :: (ContainerClass c, WidgetClass widget) => c - -> widget -- ^ Child widget - -> String -- ^ Property name - -> IO GenericValue -containerChildGetProperty con child prop = - alloca $ \valPtr -> - withUTFString prop $ \strPtr -> do - {#call unsafe container_child_get_property#} (toContainer con) - (toWidget child) strPtr valPtr - res <- peek valPtr - valueUnset valPtr +containerChildGetProperty :: (ContainerClass self, WidgetClass child) => self + -> child -- ^ @child@ - a widget which is a child of the container + -> String -- ^ @propertyName@ - the name of the property to get + -> IO GenericValue +containerChildGetProperty self child propertyName = + alloca $ \valuePtr -> + withUTFString propertyName $ \propertyNamePtr -> do + {# call unsafe container_child_get_property #} + (toContainer self) + (toWidget child) + propertyNamePtr + valuePtr + res <- peek valuePtr + valueUnset valuePtr return res -------------------- +-- Properties + +-- | Specify how resize events are handled. +-- +-- Default value: 'ResizeParent' +-- +containerResizeMode :: ContainerClass self => Attr self ResizeMode +containerResizeMode = Attr + containerGetResizeMode + containerSetResizeMode + +-- | The width of the empty border outside the containers children. +-- +-- Allowed values: \<= @('maxBound' :: Int)@ +-- +-- Default value: 0 +-- +containerBorderWidth :: ContainerClass self => Attr self Int +containerBorderWidth = Attr + containerGetBorderWidth + containerSetBorderWidth + +-------------------- -- Signals --- | This signal is called each time a new widget is added --- to this container. +-- | This signal is called each time a new widget is added to this container. -- -onAdd, afterAdd :: ContainerClass con => con -> (Widget -> IO ()) -> - IO (ConnectId con) +onAdd, afterAdd :: ContainerClass self => self + -> (Widget -> IO ()) + -> IO (ConnectId self) onAdd = connect_OBJECT__NONE "add" False afterAdd = connect_OBJECT__NONE "add" True --- | This signal is called when the widget is --- resized. +-- | This signal is called when the widget is resized. -- -onCheckResize, afterCheckResize :: ContainerClass con => con -> (IO ()) -> - IO (ConnectId con) +onCheckResize, afterCheckResize :: ContainerClass self => self + -> IO () + -> IO (ConnectId self) onCheckResize = connect_NONE__NONE "check-resize" False afterCheckResize = connect_NONE__NONE "check-resize" True @@ -378,24 +537,19 @@ onFocus = connect_ENUM__ENUM "focus" False afterFocus = connect_ENUM__ENUM "focus" True --- | This signal is called for each widget that is --- removed from the container. +-- | This signal is called for each widget that is removed from the container. -- -onRemove, afterRemove :: ContainerClass con => con -> (Widget -> IO ()) -> - IO (ConnectId con) +onRemove, afterRemove :: ContainerClass self => self + -> (Widget -> IO ()) + -> IO (ConnectId self) onRemove = connect_OBJECT__NONE "remove" False afterRemove = connect_OBJECT__NONE "remove" True - --- | This signal is called if a child in the --- container receives the input focus. +-- | This signal is called if a child in the container receives the input +-- focus. -- -onSetFocusChild, afterSetFocusChild :: ContainerClass con => con -> - (Widget -> IO ()) -> IO (ConnectId con) +onSetFocusChild, afterSetFocusChild :: ContainerClass self => self + -> (Widget -> IO ()) + -> IO (ConnectId self) onSetFocusChild = connect_OBJECT__NONE "set-focus-child" False afterSetFocusChild = connect_OBJECT__NONE "set-focus-child" True - - - - - |
|
From: Duncan C. <dun...@us...> - 2005-03-27 11:55:03
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Windows In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8898/gtk/Graphics/UI/Gtk/Windows Modified Files: Window.chs.pp Log Message: more merging from the auto-generated code: container.chs: documentation changes and code formattign changes. Also added a few extra functions and a couple properties. Window.chs.pp: added bindings for 22 extra functions (most of which are probably useful!). Index: Window.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Windows/Window.chs.pp,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- Window.chs.pp 26 Mar 2005 00:11:42 -0000 1.5 +++ Window.chs.pp 27 Mar 2005 11:54:52 -0000 1.6 @@ -67,14 +67,40 @@ WindowPosition(..), windowSetTransientFor, windowSetDestroyWithParent, + windowGetDestroyWithParent, + windowIsActive, + windowHasToplevelFocus, -- windowListToplevels, -- windowAddMnemonic, -- windowRemoveMnemonic, -- windowSetMnemonicModifier, + windowPresent, windowDeiconify, windowIconify, windowMaximize, windowUnmaximize, +#if GTK_CHECK_VERSION(2,2,0) + windowFullscreen, + windowUnfullscreen, +#endif +#if GTK_CHECK_VERSION(2,4,0) + windowSetKeepAbove, + windowSetKeepBelow, +#endif +#if GTK_CHECK_VERSION(2,2,0) + windowSetSkipTaskbarHint, + windowGetSkipTaskbarHint, + windowSetSkipPagerHint, + windowGetSkipPagerHint, +#endif +#if GTK_CHECK_VERSION(2,4,0) + windowSetAcceptFocus, + windowGetAcceptFocus, +#endif +#if GTK_CHECK_VERSION(2,6,0) + windowSetFocusOnMap, + windowGetFocusOnMap, +#endif windowSetDecorated, -- windowSetDecorationsHint, windowSetFrameDimensions, @@ -82,6 +108,14 @@ windowSetRole, windowStick, windowUnstick, + windowAddAccelGroup, + windowRemoveAccelGroup, + windowSetIcon, +#if GTK_CHECK_VERSION(2,6,0) + windowSetIconName, + windowGetIconName, + windowSetDefaultIconName, +#endif -- * Properties windowResizable, @@ -280,6 +314,66 @@ (toWindow self) (fromBool setting) +-- | Returns whether the window will be destroyed with its transient parent. +-- See 'windowSetDestroyWithParent'. +-- +windowGetDestroyWithParent :: WindowClass self => self + -> IO Bool -- ^ returns @True@ if the window will be destroyed with its + -- transient parent. +windowGetDestroyWithParent self = + liftM toBool $ + {# call gtk_window_get_destroy_with_parent #} + (toWindow self) + +#if GTK_CHECK_VERSION(2,4,0) +-- | Returns whether the window is part of the current active toplevel. (That +-- is, the toplevel window receiving keystrokes.) The return value is @True@ if +-- the window is active toplevel itself, but also if it is, say, a 'Plug' +-- embedded in the active toplevel. You might use this function if you wanted +-- to draw a widget differently in an active window from a widget in an +-- inactive window. See 'windowHasToplevelFocus' +-- +-- * Available since Gtk version 2.4 +-- +windowIsActive :: WindowClass self => self + -> IO Bool -- ^ returns @True@ if the window part of the current active + -- window. +windowIsActive self = + liftM toBool $ + {# call gtk_window_is_active #} + (toWindow self) + +-- | Returns whether the input focus is within this 'Window'. For real +-- toplevel windows, this is identical to 'windowIsActive', but for embedded +-- windows, like 'Plug', the results will differ. +-- +-- * Available since Gtk version 2.4 +-- +windowHasToplevelFocus :: WindowClass self => self + -> IO Bool -- ^ returns @True@ if the the input focus is within this 'Window' +windowHasToplevelFocus self = + liftM toBool $ + {# call gtk_window_has_toplevel_focus #} + (toWindow self) +#endif + +-- | Presents a window to the user. This may mean raising the window in the +-- stacking order, deiconifying it, moving it to the current desktop, and\/or +-- giving it the keyboard focus, possibly dependent on the user's platform, +-- window manager, and preferences. +-- +-- If @window@ is hidden, this function calls 'widgetShow' as well. +-- +-- This function should be used when the user tries to open a window that's +-- already open. Say for example the preferences dialog is currently open, and +-- the user chooses Preferences from the menu a second time; use +-- 'windowPresent' to move the already-open dialog where the user can see it. +-- +windowPresent :: WindowClass self => self -> IO () +windowPresent self = + {# call gtk_window_present #} + (toWindow self) + -- | Asks to deiconify (i.e. unminimize) the specified @window@. Note that you -- shouldn't assume the window is definitely deiconified afterward, because -- other entities (e.g. the user or window manager) could iconify it again @@ -342,6 +436,205 @@ {# call window_unmaximize #} (toWindow self) +#if GTK_CHECK_VERSION(2,2,0) +-- | Asks to place @window@ in the fullscreen state. Note that you shouldn't +-- assume the window is definitely full screen afterward, because other +-- entities (e.g. the user or window manager) could unfullscreen it again, and +-- not all window managers honor requests to fullscreen windows. But normally +-- the window will end up fullscreen. Just don't write code that crashes if +-- not. +-- +-- You can track the fullscreen state via the \"window_state_event\" signal +-- on 'Widget'. +-- +-- * Available since Gtk version 2.2 +-- +windowFullscreen :: WindowClass self => self -> IO () +windowFullscreen self = + {# call gtk_window_fullscreen #} + (toWindow self) + +-- | Asks to toggle off the fullscreen state for @window@. Note that you +-- shouldn't assume the window is definitely not full screen afterward, because +-- other entities (e.g. the user or window manager) could fullscreen it again, +-- and not all window managers honor requests to unfullscreen windows. But +-- normally the window will end up restored to its normal state. Just don't +-- write code that crashes if not. +-- +-- You can track the fullscreen state via the \"window_state_event\" signal +-- on 'Widget'. +-- +-- * Available since Gtk version 2.2 +-- +windowUnfullscreen :: WindowClass self => self -> IO () +windowUnfullscreen self = + {# call gtk_window_unfullscreen #} + (toWindow self) +#endif + +#if GTK_CHECK_VERSION(2,4,0) +-- | Asks to keep @window@ above, so that it stays on top. Note that you +-- shouldn't assume the window is definitely above afterward, because other +-- entities (e.g. the user or window manager) could not keep it above, and not +-- all window managers support keeping windows above. But normally the window +-- will end kept above. Just don't write code that crashes if not. +-- +-- It's permitted to call this function before showing a window, in which +-- case the window will be kept above when it appears onscreen initially. +-- +-- You can track the above state via the \"window_state_event\" signal on +-- 'Widget'. +-- +-- Note that, according to the Extended Window Manager Hints specification, +-- the above state is mainly meant for user preferences and should not be used +-- by applications e.g. for drawing attention to their dialogs. +-- +-- * Available since Gtk version 2.4 +-- +windowSetKeepAbove :: WindowClass self => self + -> Bool -- ^ @setting@ - whether to keep @window@ above other windows + -> IO () +windowSetKeepAbove self setting = + {# call gtk_window_set_keep_above #} + (toWindow self) + (fromBool setting) + +-- | Asks to keep @window@ below, so that it stays in bottom. Note that you +-- shouldn't assume the window is definitely below afterward, because other +-- entities (e.g. the user or window manager) could not keep it below, and not +-- all window managers support putting windows below. But normally the window +-- will be kept below. Just don't write code that crashes if not. +-- +-- It's permitted to call this function before showing a window, in which +-- case the window will be kept below when it appears onscreen initially. +-- +-- You can track the below state via the \"window_state_event\" signal on +-- 'Widget'. +-- +-- Note that, according to the Extended Window Manager Hints specification, +-- the above state is mainly meant for user preferences and should not be used +-- by applications e.g. for drawing attention to their dialogs. +-- +-- * Available since Gtk version 2.4 +-- +windowSetKeepBelow :: WindowClass self => self + -> Bool -- ^ @setting@ - whether to keep @window@ below other windows + -> IO () +windowSetKeepBelow self setting = + {# call gtk_window_set_keep_below #} + (toWindow self) + (fromBool setting) +#endif + +#if GTK_CHECK_VERSION(2,2,0) +-- | Windows may set a hint asking the desktop environment not to display the +-- window in the task bar. This function sets this hint. +-- +-- * Available since Gtk version 2.2 +-- +windowSetSkipTaskbarHint :: WindowClass self => self + -> Bool -- ^ @setting@ - @True@ to keep this window from appearing in the + -- task bar + -> IO () +windowSetSkipTaskbarHint self setting = + {# call gtk_window_set_skip_taskbar_hint #} + (toWindow self) + (fromBool setting) + +-- | Gets the value set by 'windowSetSkipTaskbarHint' +-- +-- * Available since Gtk version 2.2 +-- +windowGetSkipTaskbarHint :: WindowClass self => self + -> IO Bool -- ^ returns @True@ if window shouldn't be in taskbar +windowGetSkipTaskbarHint self = + liftM toBool $ + {# call gtk_window_get_skip_taskbar_hint #} + (toWindow self) + +-- | Windows may set a hint asking the desktop environment not to display the +-- window in the pager. This function sets this hint. (A \"pager\" is any +-- desktop navigation tool such as a workspace switcher that displays a +-- thumbnail representation of the windows on the screen.) +-- +-- * Available since Gtk version 2.2 +-- +windowSetSkipPagerHint :: WindowClass self => self + -> Bool -- ^ @setting@ - @True@ to keep this window from appearing in the + -- pager + -> IO () +windowSetSkipPagerHint self setting = + {# call gtk_window_set_skip_pager_hint #} + (toWindow self) + (fromBool setting) + +-- | Gets the value set by 'windowSetSkipPagerHint'. +-- +-- * Available since Gtk version 2.2 +-- +windowGetSkipPagerHint :: WindowClass self => self + -> IO Bool -- ^ returns @True@ if window shouldn't be in pager +windowGetSkipPagerHint self = + liftM toBool $ + {# call gtk_window_get_skip_pager_hint #} + (toWindow self) +#endif + +#if GTK_CHECK_VERSION(2,4,0) +-- | Windows may set a hint asking the desktop environment not to receive the +-- input focus. This function sets this hint. +-- +-- * Available since Gtk version 2.4 +-- +windowSetAcceptFocus :: WindowClass self => self + -> Bool -- ^ @setting@ - @True@ to let this window receive input focus + -> IO () +windowSetAcceptFocus self setting = + {# call gtk_window_set_accept_focus #} + (toWindow self) + (fromBool setting) + +-- | Gets the value set by 'windowSetAcceptFocus'. +-- +-- * Available since Gtk version 2.4 +-- +windowGetAcceptFocus :: WindowClass self => self + -> IO Bool -- ^ returns @True@ if window should receive the input focus +windowGetAcceptFocus self = + liftM toBool $ + {# call gtk_window_get_accept_focus #} + (toWindow self) +#endif + +#if GTK_CHECK_VERSION(2,6,0) +-- | Windows may set a hint asking the desktop environment not to receive the +-- input focus when the window is mapped. This function sets this hint. +-- +-- * Available since Gtk version 2.6 +-- +windowSetFocusOnMap :: WindowClass self => self + -> Bool -- ^ @setting@ - @True@ to let this window receive input focus on + -- map + -> IO () +windowSetFocusOnMap self setting = + {# call gtk_window_set_focus_on_map #} + (toWindow self) + (fromBool setting) + +-- | Gets the value set by 'windowSetFocusOnMap'. +-- +-- * Available since Gtk version 2.6 +-- +windowGetFocusOnMap :: WindowClass self => self + -> IO Bool -- ^ returns @True@ if window should receive the input focus when + -- mapped. +windowGetFocusOnMap self = + liftM toBool $ + {# call gtk_window_get_focus_on_map #} + (toWindow self) +#endif + + -- | By default, windows are decorated with a title bar, resize controls, etc. -- Some window managers allow Gtk+ to disable these decorations, creating a -- borderless window. If you set the decorated property to @False@ using this @@ -434,6 +727,102 @@ {# call window_unstick #} (toWindow self) +-- | Associate @accelGroup@ with @window@, such that calling +-- 'accelGroupsActivate' on @window@ will activate accelerators in +-- @accelGroup@. +-- +windowAddAccelGroup :: (WindowClass self, AccelGroupClass accelGroup) => self + -> accelGroup -- ^ @accelGroup@ - a 'AccelGroup' + -> IO () +windowAddAccelGroup self accelGroup = + {# call gtk_window_add_accel_group #} + (toWindow self) + (toAccelGroup accelGroup) + +-- | Reverses the effects of 'windowAddAccelGroup'. +-- +windowRemoveAccelGroup :: (WindowClass self, AccelGroupClass accelGroup) => self + -> accelGroup -- ^ @accelGroup@ - a 'AccelGroup' + -> IO () +windowRemoveAccelGroup self accelGroup = + {# call gtk_window_remove_accel_group #} + (toWindow self) + (toAccelGroup accelGroup) + +-- | Sets up the icon representing a 'Window'. This icon is used when the +-- window is minimized (also known as iconified). Some window managers or +-- desktop environments may also place it in the window frame, or display it in +-- other contexts. +-- +-- The icon should be provided in whatever size it was naturally drawn; that +-- is, don't scale the image before passing it to Gtk+. Scaling is postponed +-- until the last minute, when the desired final size is known, to allow best +-- quality. +-- +-- If you have your icon hand-drawn in multiple sizes, use +-- 'windowSetIconList'. Then the best size will be used. +-- +-- This function is equivalent to calling 'windowSetIconList' with a +-- 1-element list. +-- +-- See also 'windowSetDefaultIconList' to set the icon for all windows in +-- your application in one go. +-- +windowSetIcon :: WindowClass self => self + -> Pixbuf -- ^ @icon@ - icon image + -> IO () +windowSetIcon self icon = + {# call gtk_window_set_icon #} + (toWindow self) + icon + +#if GTK_CHECK_VERSION(2,6,0) +-- | Sets the icon for the window from a named themed icon. See the docs for +-- 'IconTheme' for more details. +-- +-- Note that this has nothing to do with the WM_ICON_NAME property which is +-- mentioned in the ICCCM. +-- +-- * Available since Gtk version 2.6 +-- +windowSetIconName :: WindowClass self => self + -> String -- ^ @name@ - the name of the themed icon + -> IO () +windowSetIconName self name = + withUTFString name $ \namePtr -> + {# call gtk_window_set_icon_name #} + (toWindow self) + namePtr + +-- | Returns the name of the themed icon for the window, see +-- 'windowSetIconName'. +-- +-- * Available since Gtk version 2.6 +-- +windowGetIconName :: WindowClass self => self + -> IO String -- ^ returns the icon name or {@NULL@, FIXME: this should + -- probably be converted to a Maybe data type} if the window has + -- no themed icon +windowGetIconName self = + {# call gtk_window_get_icon_name #} + (toWindow self) + >>= peekUTFString + +-- | Sets an icon to be used as fallback for windows that haven't had +-- 'windowSetIconList' called on them from a named themed icon, see +-- 'windowSetIconName'. +-- +-- * Available since Gtk version 2.6 +-- +windowSetDefaultIconName :: + String -- ^ @name@ - the name of the themed icon + -> IO () +windowSetDefaultIconName name = + withUTFString name $ \namePtr -> + {# call gtk_window_set_default_icon_name #} + namePtr +#endif + -------------------- -- Properties |
|
From: Duncan C. <dun...@us...> - 2005-03-27 11:55:03
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8898 Modified Files: ChangeLog Log Message: more merging from the auto-generated code: container.chs: documentation changes and code formattign changes. Also added a few extra functions and a couple properties. Window.chs.pp: added bindings for 22 extra functions (most of which are probably useful!). Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.405 retrieving revision 1.406 diff -u -d -r1.405 -r1.406 --- ChangeLog 26 Mar 2005 01:25:58 -0000 1.405 +++ ChangeLog 27 Mar 2005 11:54:51 -0000 1.406 @@ -1,3 +1,12 @@ +2005-03-27 Duncan Coutts <du...@co...> + + * gtk/Graphics/UI/Gtk/Abstract/Container.chs: documentation changes + and code formattign changes. Also added a few extra functions and a + couple properties. + + * gtk/Graphics/UI/Gtk/Windows/Window.chs.pp: added bindings for 22 + extra functions (most of which are probably useful!). + 2005-03-26 Duncan Coutts <du...@co...> * mozembed/Graphics/UI/Gtk/MozEmbed.chs: use Int in the signal |
|
From: Duncan C. <dun...@us...> - 2005-03-26 01:26:14
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Windows In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15933/gtk/Graphics/UI/Gtk/Windows Modified Files: Dialog.chs Log Message: Ooops! over zelous merging. Minor fix. Index: Dialog.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Windows/Dialog.chs,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- Dialog.chs 26 Mar 2005 00:11:42 -0000 1.5 +++ Dialog.chs 26 Mar 2005 01:25:58 -0000 1.6 @@ -262,8 +262,8 @@ -- sensitize\/desensitize dialog buttons. -- dialogSetResponseSensitive :: DialogClass self => self - -> Int -- ^ @responseId@ - a response ID - -> Bool -- ^ @setting@ - @True@ for sensitive + -> ResponseId -- ^ @responseId@ - a response ID + -> Bool -- ^ @setting@ - @True@ for sensitive -> IO () dialogSetResponseSensitive self responseId setting = {# call dialog_set_response_sensitive #} |
|
From: Duncan C. <dun...@us...> - 2005-03-26 01:26:14
|
Update of /cvsroot/gtk2hs/gtk2hs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15933 Modified Files: ChangeLog Log Message: Ooops! over zelous merging. Minor fix. Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v retrieving revision 1.404 retrieving revision 1.405 diff -u -d -r1.404 -r1.405 --- ChangeLog 26 Mar 2005 00:11:42 -0000 1.404 +++ ChangeLog 26 Mar 2005 01:25:58 -0000 1.405 @@ -12,6 +12,9 @@ gtk/Graphics/UI/Gtk/Windows/Window.chs.pp: documentation changes and code formatting changes. + * gtk/Graphics/UI/Gtk/Windows/Dialog.chs: Ooops! over zelous merging. + Minor fix. + 2005-03-25 Duncan Coutts <du...@co...> * tools/apiGen/ModuleScan.hs: match up against existing .hs modules if |
|
From: Duncan C. <dun...@us...> - 2005-03-26 00:12:22
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Windows In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3333/gtk/Graphics/UI/Gtk/Windows Modified Files: Dialog.chs Window.chs.pp Log Message: Documentation changes and code formatting changes. Index: Dialog.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Windows/Dialog.chs,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Dialog.chs 13 Mar 2005 19:34:39 -0000 1.4 +++ Dialog.chs 26 Mar 2005 00:11:42 -0000 1.5 @@ -24,13 +24,13 @@ -- Stability : provisional -- Portability : portable (depends on GHC) -- --- A dialog is a smaller window that is used to ask the user for input. +-- Create popup windows -- module Graphics.UI.Gtk.Windows.Dialog ( --- * Description +-- * Detail -- -- | Dialog boxes are a convenient way to prompt the user for a small amount --- of input, eg. to display a message, ask a question, or anything else that +-- of input, e.g. to display a message, ask a question, or anything else that -- does not require extensive effort on the user's part. -- -- Gtk+ treats a dialog as a window split vertically. The top section is a @@ -45,7 +45,7 @@ -- -- If \'dialog\' is a newly created dialog, the two primary areas of the -- window can be accessed using 'dialogGetUpper' and --- 'dialogGetActionArea', as can be seen from the example, below. +-- 'dialogGetActionArea'. -- -- A \'modal\' dialog (that is, one which freezes the rest of the -- application from user input), can be created by calling 'windowSetModal' on @@ -81,6 +81,7 @@ -- | +----'Bin' -- | +----'Window' -- | +----Dialog +-- | +----'AboutDialog' -- | +----'ColorSelectionDialog' -- | +----'FileChooserDialog' -- | +----'FileSelection' @@ -126,98 +127,149 @@ import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} -import Graphics.UI.Gtk.General.Structs (dialogGetUpper, dialogGetActionArea, ResponseId(..), fromResponse, toResponse) +import Graphics.UI.Gtk.General.Structs (dialogGetUpper, dialogGetActionArea, + ResponseId(..), fromResponse, toResponse) {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors --- | Create a new Dialog. +-- | Creates a new dialog box. Widgets should not be packed into this 'Window' +-- directly, but into the \"upper\" and \"action area\", which are obtained +-- using 'dialogGetUpper' and 'dialogGetActionArea'. -- dialogNew :: IO Dialog -dialogNew = makeNewObject mkDialog $ liftM castPtr {#call unsafe dialog_new#} +dialogNew = + makeNewObject mkDialog $ + liftM (castPtr :: Ptr Widget -> Ptr Dialog) $ + {# call unsafe dialog_new #} -------------------- -- Methods --- | Run the dialog by entering a new main loop. +-- | Blocks in a recursive main loop until the dialog either emits the +-- response signal, or is destroyed. If the dialog is destroyed during the call +-- to 'dialogRun', it returns 'ResponseNone'. Otherwise, it returns the +-- response ID from the \"response\" signal emission. Before entering the +-- recursive main loop, 'dialogRun' calls 'widgetShow' on the dialog for you. +-- Note that you still need to show any children of the dialog yourself. -- --- * The dialog is run until it is either forced to quit (-1 will be returned) --- or until the user clicks a button (or other widget) in the action area --- that makes the dialog emit the @response@ signal (the response id --- of the pressed button will be returned). +-- During 'dialogRun', the default behavior of \"delete_event\" is disabled; +-- if the dialog receives \"delete_event\", it will not be destroyed as windows +-- usually are, and 'dialogRun' will return 'ResponseDeleteEvent'. Also, during +-- 'dialogRun' the dialog will be modal. You can force 'dialogRun' to return at +-- any time by calling 'dialogResponse' to emit the \"response\" signal. +-- Destroying the dialog during 'dialogRun' is a very bad idea, because your +-- post-run code won't know whether the dialog was destroyed or not. -- --- * To force a dialog to quit, call 'dialogResponse' on it. +-- After 'dialogRun' returns, you are responsible for hiding or destroying +-- the dialog if you wish to do so. -- --- * If this function returns the dialog still needs to be destroyed. +-- Note that even though the recursive main loop gives the effect of a modal +-- dialog (it prevents the user from interacting with other windows while the +-- dialog is run), callbacks such as timeouts, IO channel watches, DND drops, +-- etc, /will/ be triggered during a 'dialogRun' call. -- -dialogRun :: DialogClass dc => dc -> IO ResponseId -dialogRun dc = liftM toResponse $ {#call dialog_run#} (toDialog dc) +dialogRun :: DialogClass self => self + -> IO ResponseId +dialogRun self = + liftM toResponse $ + {# call dialog_run #} + (toDialog self) --- | Emit the @response@ signal on the dialog. +-- | Emits the \"response\" signal with the given response ID. Used to +-- indicate that the user has responded to the dialog in some way; typically +-- either you or 'dialogRun' will be monitoring the \"response\" signal and +-- take appropriate action. -- --- * This function can be used to add a custom widget to the action area that --- should close the dialog when activated or to close the dialog otherwise. +-- This function can be used to add a custom widget to the action area that +-- should close the dialog when activated or to close the dialog otherwise. -- -dialogResponse :: DialogClass dc => dc -> ResponseId -> IO () -dialogResponse dc resId = - {#call dialog_response#} (toDialog dc) (fromResponse resId) +dialogResponse :: DialogClass self => self + -> ResponseId + -> IO () +dialogResponse self responseId = + {# call dialog_response #} + (toDialog self) + (fromResponse responseId) --- | Add a button with a label to the action area. --- --- * The text may as well refer to a stock object. If such an object exists it --- is taken as widget. --- --- * The function returns the Button that resulted from the call. +-- | 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 dialog's action area. The button widget is returned, but +-- usually you don't need it. -- -dialogAddButton :: DialogClass dc => dc -> String -> ResponseId -> IO Button -dialogAddButton dc button resId = withUTFString button $ \strPtr -> - makeNewObject mkButton $ liftM castPtr $ {#call dialog_add_button#} - (toDialog dc) strPtr (fromResponse resId) +dialogAddButton :: DialogClass self => self + -> String -- ^ @buttonText@ - text of button, or stock ID + -> ResponseId -- ^ @responseId@ - response ID for the button + -> IO Button -- ^ returns the button widget that was added +dialogAddButton self buttonText responseId = + makeNewObject mkButton $ liftM castPtr $ + withUTFString buttonText $ \buttonTextPtr -> + {# call dialog_add_button #} + (toDialog self) + buttonTextPtr + (fromResponse responseId) --- | Add a widget to the action area. If the --- widget is put into the activated state @resId@ will be transmitted --- by the @response@ signal. --- --- * A widget that cannot be activated and therefore has to emit the response --- signal manually must be added by packing it into the action area. +-- | Adds an activatable widget to the action area of a 'Dialog', connecting a +-- signal handler that will emit the \"response\" signal on the dialog when the +-- widget is activated. The widget is appended to the end of the dialog's +-- action area. If you want to add a non-activatable widget, simply pack it +-- into the action area. -- -dialogAddActionWidget :: (DialogClass dc, WidgetClass w) => dc -> w -> - ResponseId -> IO () -dialogAddActionWidget dc child resId = {#call dialog_add_action_widget#} - (toDialog dc) (toWidget child) (fromResponse resId) +dialogAddActionWidget :: (DialogClass self, WidgetClass child) => self + -> child -- ^ @child@ - an activatable widget + -> ResponseId -- ^ @responseId@ - response ID for @child@ + -> IO () +dialogAddActionWidget self child responseId = + {# call dialog_add_action_widget #} + (toDialog self) + (toWidget child) + (fromResponse responseId) --- | Query if the dialog has a visible horizontal --- separator. +-- | Query if the dialog has a visible horizontal separator. -- -dialogGetHasSeparator :: DialogClass dc => dc -> IO Bool -dialogGetHasSeparator dc = liftM toBool $ - {#call unsafe dialog_get_has_separator#} (toDialog dc) +dialogGetHasSeparator :: DialogClass self => self -> IO Bool +dialogGetHasSeparator self = + liftM toBool $ + {# call unsafe dialog_get_has_separator #} + (toDialog self) --- | Set the default widget that is to be --- activated if the user pressed enter. The object is specified by the --- ResponseId. +-- | Sets the last widget in the dialog's action area with the given +-- 'ResponseId' as the default widget for the dialog. Pressing \"Enter\" +-- normally activates the default widget. -- -dialogSetDefaultResponse :: DialogClass dc => dc -> ResponseId -> IO () -dialogSetDefaultResponse dc resId = {#call dialog_set_default_response#} - (toDialog dc) (fromResponse resId) +dialogSetDefaultResponse :: DialogClass self => self + -> ResponseId + -> IO () +dialogSetDefaultResponse self responseId = + {# call dialog_set_default_response #} + (toDialog self) + (fromResponse responseId) --- | Set the visibility of the horizontal --- separator. +-- | Sets whether the dialog has a separator above the buttons. @True@ by +-- default. -- -dialogSetHasSeparator :: DialogClass dc => dc -> Bool -> IO () -dialogSetHasSeparator dc set = {#call dialog_set_has_separator#} - (toDialog dc) (fromBool set) +dialogSetHasSeparator :: DialogClass self => self -> Bool -> IO () +dialogSetHasSeparator self setting = + {# call dialog_set_has_separator #} + (toDialog self) + (fromBool setting) --- | Set widgets in the action are to be --- sensitive or not. +-- | Calls @'widgetSetSensitive' widget setting@ for each widget in the +-- dialog's action area with the given @responseId@. A convenient way to +-- sensitize\/desensitize dialog buttons. -- -dialogSetResponseSensitive :: DialogClass dc => dc -> ResponseId -> Bool -> - IO () -dialogSetResponseSensitive dc resId sensitive = - {#call dialog_set_response_sensitive#} (toDialog dc) (fromResponse resId) - (fromBool sensitive) +dialogSetResponseSensitive :: DialogClass self => self + -> Int -- ^ @responseId@ - a response ID + -> Bool -- ^ @setting@ - @True@ for sensitive + -> IO () +dialogSetResponseSensitive self responseId setting = + {# call dialog_set_response_sensitive #} + (toDialog self) + (fromResponse responseId) + (fromBool setting) -------------------- -- Properties @@ -226,7 +278,7 @@ -- -- Default value: @True@ -- -dialogHasSeparator :: Attr Dialog Bool +dialogHasSeparator :: DialogClass self => Attr self Bool dialogHasSeparator = Attr dialogGetHasSeparator dialogSetHasSeparator @@ -234,12 +286,13 @@ -------------------- -- Signals --- | This signal is sent when a widget in the action --- area was activated, the dialog is received a destory event or the user --- calls dialogResponse. It is usually used to terminate the dialog (by --- dialogRun for example). +-- | Emitted when an action widget is clicked, the dialog receives a delete +-- event, or the application programmer calls 'dialogResponse'. On a delete +-- event, the response ID is 'ResponseNone'. Otherwise, it depends on which +-- action widget was clicked. -- -onResponse, afterResponse :: DialogClass dc => dc -> (ResponseId -> IO ()) -> - IO (ConnectId dc) +onResponse, afterResponse :: DialogClass self => self + -> (ResponseId -> IO ()) + -> IO (ConnectId self) onResponse dia act = connect_INT__NONE "response" False dia (act . toResponse) afterResponse dia act = connect_INT__NONE "response" True dia (act . toResponse) Index: Window.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Windows/Window.chs.pp,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Window.chs.pp 13 Mar 2005 19:34:39 -0000 1.4 +++ Window.chs.pp 26 Mar 2005 00:11:42 -0000 1.5 @@ -109,164 +109,330 @@ -------------------- -- Constructors --- | Create a new window of the given type. +-- | Create a new top level window. -- windowNew :: IO Window -windowNew = makeNewObject mkWindow $ liftM castPtr $ - {#call window_new#} ((fromIntegral.fromEnum) WindowToplevel) +windowNew = + makeNewObject mkWindow $ + liftM (castPtr :: Ptr Widget -> Ptr Window) $ + {# call window_new #} + ((fromIntegral . fromEnum) WindowToplevel) -------------------- -- Methods --- | set the title string of the given window +-- | Sets the title of the 'Window'. The title of a window will be displayed +-- in its title bar; on the X Window System, the title bar is rendered by the +-- window manager, so exactly how the title appears to users may vary according +-- to a user's exact configuration. The title should help a user distinguish +-- this window from other windows they may have open. A good title might +-- include the application name and current document filename, for example. -- -windowSetTitle :: WindowClass w => w -> String -> IO () -windowSetTitle w str = - withUTFString str ({#call window_set_title#} (toWindow w)) +windowSetTitle :: WindowClass self => self -> String -> IO () +windowSetTitle self title = + withUTFString title $ \titlePtr -> + {# call gtk_window_set_title #} + (toWindow self) + titlePtr --- | Sets whether the user can resize a window. --- --- * Windows are user resizable by default. +-- | Sets whether the user can resize a window. Windows are user resizable by +-- default. -- -windowSetResizable :: WindowClass w => w -> Bool -> IO () -windowSetResizable w res = - {#call window_set_resizable#} (toWindow w) (fromBool res) +windowSetResizable :: WindowClass self => self -> Bool -> IO () +windowSetResizable self resizable = + {# call window_set_resizable #} + (toWindow self) + (fromBool resizable) --- | Retrieve the value set by --- 'windowSetResizable'. +-- | Gets the value set by 'windowSetResizable'. -- -windowGetResizable :: WindowClass w => w -> IO Bool -windowGetResizable w = liftM toBool $ - {#call unsafe window_get_resizable#} (toWindow w) +windowGetResizable :: WindowClass self => self + -> IO Bool -- ^ returns @True@ if the user can resize the window +windowGetResizable self = + liftM toBool $ + {# call unsafe window_get_resizable #} + (toWindow self) --- | dunno +-- | Activates the current focused widget within the window. -- -windowActivateFocus :: WindowClass w => w -> IO Bool -windowActivateFocus w = - liftM toBool $ {#call window_activate_focus#} (toWindow w) +windowActivateFocus :: WindowClass self => self + -> IO Bool -- ^ returns @True@ if a widget got activated. +windowActivateFocus self = + liftM toBool $ + {# call window_activate_focus #} + (toWindow self) --- | dunno +-- | Activates the default widget for the window, unless the current focused +-- widget has been configured to receive the default action (see +-- 'ReceivesDefault' in 'WidgetFlags'), in which case the focused widget is +-- activated. -- -windowActivateDefault :: WindowClass w => w -> IO Bool -windowActivateDefault w = - liftM toBool $ {#call window_activate_default#} (toWindow w) +windowActivateDefault :: WindowClass self => self + -> IO Bool -- ^ returns @True@ if a widget got activated. +windowActivateDefault self = + liftM toBool $ + {# call window_activate_default #} + (toWindow self) #ifndef DISABLE_DEPRECATED {-# DEPRECATED windowSetPolicy "Use windowSetResizable instead." #-} --- windowSetPolicy: set the window policy +-- | Sets the window resizing policy. -- -windowSetPolicy :: WindowClass w => w -> Bool -> Bool -> Bool -> IO () -windowSetPolicy w shrink grow auto = {#call window_set_policy#} - (toWindow w) (fromBool shrink) (fromBool grow) (fromBool auto) +-- * Warning: this function is deprecated and should not be used in +-- newly-written code. Use 'windowSetResizable' instead. +-- +windowSetPolicy :: WindowClass self => self -> Bool -> Bool -> Bool -> IO () +windowSetPolicy self allowShrink allowGrow autoShrink = + {# call window_set_policy #} + (toWindow self) + (fromBool allowShrink) + (fromBool allowGrow) + (fromBool autoShrink) #endif --- | make a window application modal +-- | Sets a window modal or non-modal. Modal windows prevent interaction with +-- other windows in the same application. To keep modal dialogs on top of main +-- application windows, use 'windowSetTransientFor' to make the dialog +-- transient for the parent; most window managers will then disallow lowering +-- the dialog below the parent. -- -windowSetModal :: WindowClass w => w -> Bool -> IO () -windowSetModal w m = {#call window_set_modal#} (toWindow w) (fromBool m) +windowSetModal :: WindowClass self => self + -> Bool -- ^ @modal@ - whether the window is modal + -> IO () +windowSetModal self modal = + {# call window_set_modal #} + (toWindow self) + (fromBool modal) --- | set window default size +-- | Sets the default size of a window. If the window's \"natural\" size (its +-- size request) is larger than the default, the default will be ignored. More +-- generally, if the default size does not obey the geometry hints for the +-- window ('windowSetGeometryHints' can be used to set these explicitly), the +-- default size will be clamped to the nearest permitted size. -- --- * Sets the default size of a window. If the window's \"natural\" size (its --- size request) is larger than the default, the default will be ignored. --- More generally, if the default size does not obey the geometry hints for --- the window ('windowSetGeometryHints' can be used to set these --- explicitly), the default size will be clamped to the nearest permitted --- size. +-- Unlike 'widgetSetSizeRequest', which sets a size request for a widget and +-- thus would keep users from shrinking the window, this function only sets the +-- initial size, just as if the user had resized the window themselves. Users +-- can still shrink the window again as they normally would. Setting a default +-- size of -1 means to use the \"natural\" default size (the size request of +-- the window). -- --- * Unlike @widgetSetSizeRequest@, which sets a size request for a --- widget and thus would keep users from shrinking the window, this function --- only sets the initial size, just as if the user had resized the window --- themselves. Users can still shrink the window again as they normally --- would. Setting a default size of -1 means to use the \"natural\" default --- size (the size request of the window). +-- For more control over a window's initial size and how resizing works, +-- investigate 'windowSetGeometryHints'. -- --- * For more control over a window's initial size and how resizing works, --- investigate 'windowSetGeometryHints'. +-- For some uses, 'windowResize' is a more appropriate function. +-- 'windowResize' changes the current size of the window, rather than the size +-- to be used on initial display. 'windowResize' always affects the window +-- itself, not the geometry widget. -- --- * For some uses, 'windowResize' is a more appropriate function. --- 'windowResize' changes the current size of the window, rather --- than the size to be used on initial display. 'windowResize' --- always affects the window itself, not the geometry widget.The default --- size of a window only affects the first time a window is shown; if a --- window is hidden and re-shown, it will remember the size it had prior to --- hiding, rather than using the default size. Windows can't actually be 0x0 --- in size, they must be at least 1x1, but passing 0 for width and height is --- OK, resulting in a 1x1 default size. +-- The default size of a window only affects the first time a window is +-- shown; if a window is hidden and re-shown, it will remember the size it had +-- prior to hiding, rather than using the default size. -- -windowSetDefaultSize :: WindowClass w => w -> Int -> Int -> IO () -windowSetDefaultSize w height width = - {#call window_set_default_size#} (toWindow w) (fromIntegral height) - (fromIntegral width) +-- Windows can't actually be 0x0 in size, they must be at least 1x1, but +-- passing 0 for @width@ and @height@ is OK, resulting in a 1x1 default size. +-- +windowSetDefaultSize :: WindowClass self => self + -> Int -- ^ @height@ - height in pixels, or -1 to unset the default height + -> Int -- ^ @width@ - width in pixels, or -1 to unset the default width + -> IO () +windowSetDefaultSize self height width = + {# call window_set_default_size #} + (toWindow self) + (fromIntegral height) + (fromIntegral width) --- | set the window position policy +-- | Sets a position constraint for this window. If the old or new constraint +-- is 'WinPosCenterAlways', this will also cause the window to be repositioned +-- to satisfy the new constraint. -- -windowSetPosition :: WindowClass w => w -> WindowPosition -> IO () -windowSetPosition w pos = - {#call window_set_position#} (toWindow w) ((fromIntegral.fromEnum) pos) +windowSetPosition :: WindowClass self => self -> WindowPosition -> IO () +windowSetPosition self position = + {# call window_set_position #} + (toWindow self) + ((fromIntegral . fromEnum) position) --- | set transient window +-- | Dialog windows should be set transient for the main application window +-- they were spawned from. This allows window managers to e.g. keep the dialog +-- on top of the main window, or center the dialog over the main window. +-- 'dialogNewWithButtons' and other convenience functions in Gtk+ will +-- sometimes call 'windowSetTransientFor' on your behalf. -- -windowSetTransientFor :: (WindowClass win, WindowClass parent) => win -> - parent -> IO () -windowSetTransientFor w p = - {#call window_set_transient_for#} (toWindow w) (toWindow p) +-- On Windows, this function will and put the child window on top of the +-- parent, much as the window manager would have done on X. +-- +windowSetTransientFor :: (WindowClass self, WindowClass parent) => self + -> parent -- ^ @parent@ - parent window + -> IO () +windowSetTransientFor self parent = + {# call window_set_transient_for #} + (toWindow self) + (toWindow parent) --- | destory transient window with parent +-- | If this setting is @True@, then destroying the transient parent of the +-- window will also destroy the window itself. This is useful for dialogs that +-- shouldn't persist beyond the lifetime of the main window they\'re associated +-- with, for example. -- -windowSetDestroyWithParent :: WindowClass w => w -> Bool -> IO () -windowSetDestroyWithParent w b = - {#call window_set_destroy_with_parent#} (toWindow w) (fromBool b) +windowSetDestroyWithParent :: WindowClass self => self -> Bool -> IO () +windowSetDestroyWithParent self setting = + {# call window_set_destroy_with_parent #} + (toWindow self) + (fromBool setting) --- | restore the window +-- | Asks to deiconify (i.e. unminimize) the specified @window@. Note that you +-- shouldn't assume the window is definitely deiconified afterward, because +-- other entities (e.g. the user or window manager) could iconify it again +-- before your code which assumes deiconification gets to run. -- -windowDeiconify :: WindowClass w => w -> IO () -windowDeiconify w = {#call window_deiconify#} (toWindow w) +-- You can track iconification via the \"window_state_event\" signal on +-- 'Widget'. +-- +windowDeiconify :: WindowClass self => self -> IO () +windowDeiconify self = + {# call window_deiconify #} + (toWindow self) --- | minimize the window +-- | Asks to iconify (i.e. minimize) the specified @window@. Note that you +-- shouldn't assume the window is definitely iconified afterward, because other +-- entities (e.g. the user or window manager) could deiconify it again, or +-- there may not be a window manager in which case iconification isn't +-- possible, etc. But normally the window will end up iconified. Just don't +-- write code that crashes if not. -- -windowIconify :: WindowClass w => w -> IO () -windowIconify w = {#call window_iconify#} (toWindow w) +-- It's permitted to call this function before showing a window, in which +-- case the window will be iconified before it ever appears onscreen. +-- +-- You can track iconification via the \"window_state_event\" signal on +-- 'Widget'. +-- +windowIconify :: WindowClass self => self -> IO () +windowIconify self = + {# call window_iconify #} + (toWindow self) --- | maximize the window +-- | Asks to maximize the window, so that it becomes full-screen. Note that you +-- shouldn't assume the window is definitely maximized afterward, because other +-- entities (e.g. the user or window manager) could unmaximize it again, and +-- not all window managers support maximization. But normally the window will +-- end up maximized. Just don't write code that crashes if not. -- -windowMaximize :: WindowClass w => w -> IO () -windowMaximize w = {#call window_maximize#} (toWindow w) +-- It's permitted to call this function before showing a window, in which +-- case the window will be maximized when it appears onscreen initially. +-- +-- You can track maximization via the \"window_state_event\" signal on +-- 'Widget'. +-- +windowMaximize :: WindowClass self => self -> IO () +windowMaximize self = + {# call window_maximize #} + (toWindow self) --- | unmaximize the window +-- | Asks to unmaximize the window. Note that you shouldn't assume the window is +-- definitely unmaximized afterward, because other entities (e.g. the user or +-- window manager) could maximize it again, and not all window managers honor +-- requests to unmaximize. But normally the window will end up unmaximized. +-- Just don't write code that crashes if not. -- -windowUnmaximize :: WindowClass w => w -> IO () -windowUnmaximize w = {#call window_unmaximize#} (toWindow w) +-- You can track maximization via the \"window_state_event\" signal on +-- 'Widget'. +-- +windowUnmaximize :: WindowClass self => self -> IO () +windowUnmaximize self = + {# call window_unmaximize #} + (toWindow self) --- | remove the border +-- | By default, windows are decorated with a title bar, resize controls, etc. +-- Some window managers allow Gtk+ to disable these decorations, creating a +-- borderless window. If you set the decorated property to @False@ using this +-- function, Gtk+ will do its best to convince the window manager not to +-- decorate the window. Depending on the system, this function may not have any +-- effect when called on a window that is already visible, so you should call +-- it before calling 'windowShow'. -- -windowSetDecorated :: WindowClass w => w -> Bool -> IO () -windowSetDecorated w b = - {#call window_set_decorated#} (toWindow w) (fromBool b) +-- On Windows, this function always works, since there's no window manager +-- policy involved. +-- +windowSetDecorated :: WindowClass self => self -> Bool -> IO () +windowSetDecorated self setting = + {# call window_set_decorated #} + (toWindow self) + (fromBool setting) --- | set border widths +-- | (Note: this is a special-purpose function intended for the framebuffer +-- port; see 'windowSetHasFrame'. It will have no effect on the window border +-- drawn by the window manager, which is the normal case when using the X +-- Window system.) -- -windowSetFrameDimensions :: WindowClass w => w -> Int -> Int -> Int -> Int -> - IO () -windowSetFrameDimensions w left top right bottom = - {#call window_set_frame_dimensions#} (toWindow w) (fromIntegral left) - (fromIntegral top) (fromIntegral right) (fromIntegral bottom) +-- For windows with frames (see 'windowSetHasFrame') this function can be +-- used to change the size of the frame border. +-- +windowSetFrameDimensions :: WindowClass self => self + -> Int -- ^ @left@ - The width of the left border + -> Int -- ^ @top@ - The height of the top border + -> Int -- ^ @right@ - The width of the right border + -> Int -- ^ @bottom@ - The height of the bottom border + -> IO () +windowSetFrameDimensions self left top right bottom = + {# call window_set_frame_dimensions #} + (toWindow self) + (fromIntegral left) + (fromIntegral top) + (fromIntegral right) + (fromIntegral bottom) --- | set role (additional window name for the WM) +-- | This function is only useful on X11, not with other Gtk+ targets. -- -windowSetRole :: WindowClass w => w -> String -> IO () -windowSetRole w str = - withUTFString str ({#call window_set_role#} (toWindow w)) +-- In combination with the window title, the window role allows a window +-- manager to identify \"the same\" window when an application is restarted. So +-- for example you might set the \"toolbox\" role on your app's toolbox window, +-- so that when the user restarts their session, the window manager can put the +-- toolbox back in the same place. +-- +-- If a window already has a unique title, you don't need to set the role, +-- since the WM can use the title to identify the window when restoring the +-- session. +-- +windowSetRole :: WindowClass self => self + -> String -- ^ @role@ - unique identifier for the window to be used when + -- restoring a session + -> IO () +windowSetRole self role = + withUTFString role $ \rolePtr -> + {# call window_set_role #} + (toWindow self) + rolePtr --- | show the window on every workspace +-- | Asks to stick @window@, which means that it will appear on all user +-- desktops. Note that you shouldn't assume the window is definitely stuck +-- afterward, because other entities (e.g. the user or window manager) could +-- unstick it again, and some window managers do not support sticking windows. +-- But normally the window will end up stuck. Just don't write code that +-- crashes if not. -- -windowStick :: WindowClass w => w -> IO () -windowStick w = {#call window_stick#} (toWindow w) +-- It's permitted to call this function before showing a window. +-- +-- You can track stickiness via the \"window_state_event\" signal on +-- 'Widget'. +-- +windowStick :: WindowClass self => self -> IO () +windowStick self = + {# call window_stick #} + (toWindow self) --- | do not show the window on every workspace +-- | Asks to unstick @window@, which means that it will appear on only one of +-- the user's desktops. Note that you shouldn't assume the window is definitely +-- unstuck afterward, because other entities (e.g. the user or window manager) +-- could stick it again. But normally the window will end up stuck. Just don't +-- write code that crashes if not. -- -windowUnstick :: WindowClass w => w -> IO () -windowUnstick w = {#call window_unstick#} (toWindow w) +-- You can track stickiness via the \"window_state_event\" signal on +-- 'Widget'. +-- +windowUnstick :: WindowClass self => self -> IO () +windowUnstick self = + {# call window_unstick #} + (toWindow self) -------------------- -- Properties @@ -275,7 +441,7 @@ -- -- Default value: @True@ -- -windowResizable :: Attr Window Bool +windowResizable :: WindowClass self => Attr self Bool windowResizable = Attr windowGetResizable windowSetResizable @@ -285,17 +451,16 @@ -- | -- -onFrameEvent, afterFrameEvent :: WindowClass w => w -> (Event -> IO Bool) -> - IO (ConnectId w) +onFrameEvent, afterFrameEvent :: WindowClass self => self + -> (Event -> IO Bool) + -> IO (ConnectId self) onFrameEvent = connect_BOXED__BOOL "frame_event" marshalEvent False afterFrameEvent = connect_BOXED__BOOL "frame_event" marshalEvent True -- | -- -onSetFocus, afterSetFocus :: (WindowClass w, WidgetClass foc) => w -> - (foc -> IO ()) -> IO (ConnectId w) +onSetFocus, afterSetFocus :: (WindowClass self, WidgetClass foc) => self + -> (foc -> IO ()) + -> IO (ConnectId self) onSetFocus = connect_OBJECT__NONE "set_focus" False afterSetFocus = connect_OBJECT__NONE "set_focus" True - - - |
2 messages has been excluded from this view by a project administrator.
