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

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

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

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


--- NEW FILE: EventBox.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget EventBox
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:42 $
--
--  Copyright (c) 1999..2002 Axel Simon
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
-- |
--
-- This container can be used to receive 'Event's for a widget
-- that has no window on its own.
--
-- TODO
--
-- * check: Is this widget useful?
--
module EventBox(
  EventBox,
  EventBoxClass,
  castToEventBox,
  eventBoxNew
#if GTK_CHECK_VERSION(2,4,0)
 ,eventBoxSetVisibleWindow,
  eventBoxGetVisibleWindow,
  eventBoxSetAboveChild,
  eventBoxGetAboveChild
#endif
  ) where

import Monad	(liftM)
import FFI

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

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

-- methods

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

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

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

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

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

--- EventBox.chspp DELETED ---

--- FileChooserWidget.chspp DELETED ---

--- Calendar.chspp DELETED ---

--- NEW FILE: FileChooserWidget.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) entry Widget FileChooserWidget
--
--  Author : Duncan Coutts
--  Created: 24 April 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Library General Public License for more details.
--
-- |
--
--  The file chooser dialog and widget is a replacement
--  for the old "FileSel"ection dialog. It provides a better user
--  interface and an improved API.
--
-- * This is the widget variant of the "FileChooser"
--
-- * Added in GTK+ 2.4
--
module FileChooserWidget (
#if GTK_CHECK_VERSION(2,4,0)
  FileChooserWidgetClass,
  FileChooserWidget,
  FileChooserAction,
  fileChooserWidgetNew,
  fileChooserWidgetNewWithBackend,
#endif
) where

#if GTK_CHECK_VERSION(2,4,0)

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

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

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

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

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

#endif

--- NEW FILE: Calendar.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Calendar
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:42 $
--
--  Copyright (c) 1999..2002 Axel Simon
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
-- |
--
-- This widget shows a calendar.
--
module Calendar(
  Calendar,
  CalendarClass,
  castToCalendar,
  calendarNew,
  calendarSelectMonth,
  calendarSelectDay,
  calendarMarkDay,
  calendarUnmarkDay,
  calendarClearMarks,
  calendarDisplayOptions,
#if GTK_CHECK_VERSION(2,4,0)
  calendarSetDisplayOptions,
  calendarGetDisplayOptions,
#endif
  calendarGetDate,
  onDaySelected,
  afterDaySelected,
  onDaySelectedDoubleClick,
  afterDaySelectedDoubleClick,
  onMonthChanged,
  afterMonthChanged,
  onNextMonth,
  afterNextMonth,
  onNextYear,
  afterNextYear,
  onPrevMonth,
  afterPrevMonth,
  onPrevYear,
  afterPrevYear
  ) where

import Monad	(liftM)
import FFI

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

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

-- methods

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

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

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

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

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

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

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

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

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

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

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

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

-- signals

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

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

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

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

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

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

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

  

--- Tooltips.chspp DELETED ---

--- NEW FILE: Tooltips.chs.cpp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Tooltips
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:42 $
--
--  Copyright (c) 1999..2002 Axel Simon
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
-- |
--
-- Tooltips are the messages that appear next to a widget when the mouse
-- pointer is held over it for a short amount of time. They are especially
-- helpful for adding more verbose descriptions of things such as buttons
-- in a toolbar. 
--
-- An individual tooltip belongs to a group of tooltips. A group is created
-- with a call to 'tooltipsNew'. Every tooltip in the group can 
-- then be turned off with a call to 'tooltipsDisable' and enabled with 
-- 'tooltipsEnable'.
--
#ifndef DISABLE_DEPRECATED
-- The length of time the user must keep the mouse over a widget before the tip
-- is shown, can be altered with 'tooltipsSetDelay'. This is set on a 'per group
-- of tooltips' basis.
--
#endif
-- To assign a tip to a particular widget, 'tooltipsSetTip' is used.
--
-- To associate 'Tooltips' to a widget it is has to have its own 'DrawWindow'.
-- Otherwise the widget must be set into an 'EventBox'.
--
module Tooltips(
  Tooltips,
  TooltipsClass,
  castToTooltips,
  tooltipsNew,
  tooltipsEnable,
  tooltipsDisable,
#ifndef DISABLE_DEPRECATED
  tooltipsSetDelay,
#endif
  tooltipsSetTip,
  tooltipsDataGet
  ) where

import Monad	(liftM)
import FFI

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

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

-- methods

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

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

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

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

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

{#pointer * TooltipsData#}

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