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 |