{-# LINE 2 "./Graphics/UI/Gtk/Misc/Calendar.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget Calendar
--
-- Author : Axel Simon
--
-- Created: 23 May 2001
--
-- Copyright (C) 1999-2005 Axel Simon
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- Displays a calendar and allows the user to select a date
--
module Graphics.UI.Gtk.Misc.Calendar (
-- * Detail
--
-- | 'Calendar' is a widget that displays a calendar, one month at a time. It
-- can be created with 'calendarNew'.
--
-- The month and year currently displayed can be altered with
-- 'calendarSelectMonth'. The exact day can be selected from the displayed
-- month using 'calendarSelectDay'.
--
-- To place a visual marker on a particular day, use 'calendarMarkDay' and
-- to remove the marker, 'calendarUnmarkDay'. Alternative, all marks can be
-- cleared with 'calendarClearMarks'.
--
-- The way in which the calendar itself is displayed can be altered using
-- 'calendarSetDisplayOptions'.
--
-- The selected date can be retrieved from a 'Calendar' using
-- 'calendarGetDate'.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----'Widget'
-- | +----Calendar
-- @

-- * Types
  Calendar,
  CalendarClass,
  castToCalendar, gTypeCalendar,
  toCalendar,
  CalendarDisplayOptions(..),

-- * Constructors
  calendarNew,

-- * Methods
  calendarSelectMonth,
  calendarSelectDay,
  calendarMarkDay,
  calendarUnmarkDay,
  calendarClearMarks,






  calendarSetDisplayOptions,
  calendarGetDisplayOptions,

  calendarGetDate,






-- * Attributes
  calendarYear,
  calendarMonth,
  calendarDay,

  calendarShowHeading,
  calendarShowDayNames,
  calendarNoMonthChange,
  calendarShowWeekNumbers,

-- calendarDisplayOptions,

-- * Signals
  onDaySelected,
  afterDaySelected,
  onDaySelectedDoubleClick,
  afterDaySelectedDoubleClick,
  onMonthChanged,
  afterMonthChanged,
  onNextMonth,
  afterNextMonth,
  onNextYear,
  afterNextYear,
  onPrevMonth,
  afterPrevMonth,
  onPrevYear,
  afterPrevYear,
  ) where

import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.Flags (fromFlags, toFlags)
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Types
{-# LINE 126 "./Graphics/UI/Gtk/Misc/Calendar.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 127 "./Graphics/UI/Gtk/Misc/Calendar.chs" #-}
import Graphics.UI.Gtk.General.Enums (CalendarDisplayOptions(..))


{-# LINE 130 "./Graphics/UI/Gtk/Misc/Calendar.chs" #-}

--------------------
-- Constructors

-- | Creates a new calendar, with the current date being selected.
--
calendarNew :: IO Calendar
calendarNew :: IO Calendar
calendarNew =
  (ForeignPtr Calendar -> Calendar, FinalizerPtr Calendar)
-> IO (Ptr Calendar) -> IO Calendar
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Calendar -> Calendar, FinalizerPtr Calendar)
forall {a}. (ForeignPtr Calendar -> Calendar, FinalizerPtr a)
mkCalendar (IO (Ptr Calendar) -> IO Calendar)
-> IO (Ptr Calendar) -> IO Calendar
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr Calendar)
-> IO (Ptr Widget) -> IO (Ptr Calendar)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Calendar
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Calendar) (IO (Ptr Widget) -> IO (Ptr Calendar))
-> IO (Ptr Widget) -> IO (Ptr Calendar)
forall a b. (a -> b) -> a -> b
$
  IO (Ptr Widget)
gtk_calendar_new
{-# LINE 141 "./Graphics/UI/Gtk/Misc/Calendar.chs" #-}

--------------------
-- Methods

-- | Shifts the calendar to a different month.
--
calendarSelectMonth :: CalendarClass self => self
 -> Int -- ^ @month@ - a month number between 0 and 11.
 -> Int -- ^ @year@ - the year the month is in.
 -> IO ()
calendarSelectMonth :: forall self. CalendarClass self => self -> Int -> Int -> IO ()
calendarSelectMonth self
self Int
month Int
year =
  (() -> ()) -> IO () -> IO ()
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (() -> () -> ()
forall a b. a -> b -> a
const ()) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
  (\(Calendar ForeignPtr Calendar
arg1) CUInt
arg2 CUInt
arg3 -> ForeignPtr Calendar -> (Ptr Calendar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Calendar
arg1 ((Ptr Calendar -> IO ()) -> IO ())
-> (Ptr Calendar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Calendar
argPtr1 ->Ptr Calendar -> CUInt -> CUInt -> IO ()
gtk_calendar_select_month Ptr Calendar
argPtr1 CUInt
arg2 CUInt
arg3)
{-# LINE 154 "./Graphics/UI/Gtk/Misc/Calendar.chs" #-}
    (toCalendar self)
    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
month)
    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
year)

-- | Selects a day from the current month.
--
calendarSelectDay :: CalendarClass self => self
 -> Int -- ^ @day@ - the day number between 1 and 31, or 0 to unselect the
          -- currently selected day.
 -> IO ()
calendarSelectDay :: forall self. CalendarClass self => self -> Int -> IO ()
calendarSelectDay self
self Int
day =
  (\(Calendar ForeignPtr Calendar
arg1) CUInt
arg2 -> ForeignPtr Calendar -> (Ptr Calendar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Calendar
arg1 ((Ptr Calendar -> IO ()) -> IO ())
-> (Ptr Calendar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Calendar
argPtr1 ->Ptr Calendar -> CUInt -> IO ()
gtk_calendar_select_day Ptr Calendar
argPtr1 CUInt
arg2)
{-# LINE 166 "./Graphics/UI/Gtk/Misc/Calendar.chs" #-}
    (toCalendar self)
    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
day)

-- | Places a visual marker on a particular day.
--
calendarMarkDay :: CalendarClass self => self
 -> Int -- ^ @day@ - the day number to mark between 1 and 31.
 -> IO ()
calendarMarkDay :: forall self. CalendarClass self => self -> Int -> IO ()
calendarMarkDay self
self Int
day =
  (() -> ()) -> IO () -> IO ()
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (() -> () -> ()
forall a b. a -> b -> a
const ()) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
  (\(Calendar ForeignPtr Calendar
arg1) CUInt
arg2 -> ForeignPtr Calendar -> (Ptr Calendar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Calendar
arg1 ((Ptr Calendar -> IO ()) -> IO ())
-> (Ptr Calendar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Calendar
argPtr1 ->Ptr Calendar -> CUInt -> IO ()
gtk_calendar_mark_day Ptr Calendar
argPtr1 CUInt
arg2)
{-# LINE 177 "./Graphics/UI/Gtk/Misc/Calendar.chs" #-}
    (toCalendar self)
    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
day)

-- | Removes the visual marker from a particular day.
--
calendarUnmarkDay :: CalendarClass self => self
 -> Int -- ^ @day@ - the day number to unmark between 1 and 31.
 -> IO ()
calendarUnmarkDay :: forall self. CalendarClass self => self -> Int -> IO ()
calendarUnmarkDay self
self Int
day =
  (() -> ()) -> IO () -> IO ()
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (() -> () -> ()
forall a b. a -> b -> a
const ()) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
  (\(Calendar ForeignPtr Calendar
arg1) CUInt
arg2 -> ForeignPtr Calendar -> (Ptr Calendar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Calendar
arg1 ((Ptr Calendar -> IO ()) -> IO ())
-> (Ptr Calendar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Calendar
argPtr1 ->Ptr Calendar -> CUInt -> IO ()
gtk_calendar_unmark_day Ptr Calendar
argPtr1 CUInt
arg2)
{-# LINE 188 "./Graphics/UI/Gtk/Misc/Calendar.chs" #-}
    (toCalendar self)
    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
day)

-- | Remove all visual markers.
--
calendarClearMarks :: CalendarClass self => self -> IO ()
calendarClearMarks :: forall self. CalendarClass self => self -> IO ()
calendarClearMarks self
self =
  (\(Calendar ForeignPtr Calendar
arg1) -> ForeignPtr Calendar -> (Ptr Calendar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Calendar
arg1 ((Ptr Calendar -> IO ()) -> IO ())
-> (Ptr Calendar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Calendar
argPtr1 ->Ptr Calendar -> IO ()
gtk_calendar_clear_marks Ptr Calendar
argPtr1)
{-# LINE 196 "./Graphics/UI/Gtk/Misc/Calendar.chs" #-}
    (toCalendar self)


-- | Sets display options (whether to display the heading and the month
-- headings).
--
-- * Available since Gtk+ version 2.4
--
calendarSetDisplayOptions :: CalendarClass self => self
 -> [CalendarDisplayOptions]
 -> IO ()
calendarSetDisplayOptions :: forall self.
CalendarClass self =>
self -> [CalendarDisplayOptions] -> IO ()
calendarSetDisplayOptions self
self [CalendarDisplayOptions]
flags =
  (\(Calendar ForeignPtr Calendar
arg1) CInt
arg2 -> ForeignPtr Calendar -> (Ptr Calendar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Calendar
arg1 ((Ptr Calendar -> IO ()) -> IO ())
-> (Ptr Calendar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Calendar
argPtr1 ->Ptr Calendar -> CInt -> IO ()
gtk_calendar_set_display_options Ptr Calendar
argPtr1 CInt
arg2)
{-# LINE 209 "./Graphics/UI/Gtk/Misc/Calendar.chs" #-}
    (toCalendar self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt)
-> ([CalendarDisplayOptions] -> Int)
-> [CalendarDisplayOptions]
-> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CalendarDisplayOptions] -> Int
forall a. Flags a => [a] -> Int
fromFlags) [CalendarDisplayOptions]
flags)

-- | Returns the current display options for the calendar.
--
-- * Available since Gtk+ version 2.4
--
calendarGetDisplayOptions :: CalendarClass self => self
 -> IO [CalendarDisplayOptions]
calendarGetDisplayOptions :: forall self.
CalendarClass self =>
self -> IO [CalendarDisplayOptions]
calendarGetDisplayOptions self
self =
  (CInt -> [CalendarDisplayOptions])
-> IO CInt -> IO [CalendarDisplayOptions]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> [CalendarDisplayOptions]
forall a. Flags a => Int -> [a]
toFlags (Int -> [CalendarDisplayOptions])
-> (CInt -> Int) -> CInt -> [CalendarDisplayOptions]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO [CalendarDisplayOptions])
-> IO CInt -> IO [CalendarDisplayOptions]
forall a b. (a -> b) -> a -> b
$
  (\(Calendar ForeignPtr Calendar
arg1) -> ForeignPtr Calendar -> (Ptr Calendar -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Calendar
arg1 ((Ptr Calendar -> IO CInt) -> IO CInt)
-> (Ptr Calendar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Calendar
argPtr1 ->Ptr Calendar -> IO CInt
gtk_calendar_get_display_options Ptr Calendar
argPtr1)
{-# LINE 221 "./Graphics/UI/Gtk/Misc/Calendar.chs" #-}
    (toCalendar self)
{-# LINE 242 "./Graphics/UI/Gtk/Misc/Calendar.chs" #-}
-- | Retrieve the currently selected date.
--
calendarGetDate :: CalendarClass self => self
 -> IO (Int,Int,Int) -- ^ @(year, month, day)@
calendarGetDate :: forall self. CalendarClass self => self -> IO (Int, Int, Int)
calendarGetDate self
self =
  (Ptr CUInt -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CUInt -> IO (Int, Int, Int)) -> IO (Int, Int, Int))
-> (Ptr CUInt -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
yearPtr ->
  (Ptr CUInt -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CUInt -> IO (Int, Int, Int)) -> IO (Int, Int, Int))
-> (Ptr CUInt -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
monthPtr ->
  (Ptr CUInt -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CUInt -> IO (Int, Int, Int)) -> IO (Int, Int, Int))
-> (Ptr CUInt -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
dayPtr -> do
  (\(Calendar ForeignPtr Calendar
arg1) Ptr CUInt
arg2 Ptr CUInt
arg3 Ptr CUInt
arg4 -> ForeignPtr Calendar -> (Ptr Calendar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Calendar
arg1 ((Ptr Calendar -> IO ()) -> IO ())
-> (Ptr Calendar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Calendar
argPtr1 ->Ptr Calendar -> Ptr CUInt -> Ptr CUInt -> Ptr CUInt -> IO ()
gtk_calendar_get_date Ptr Calendar
argPtr1 Ptr CUInt
arg2 Ptr CUInt
arg3 Ptr CUInt
arg4)
{-# LINE 251 "./Graphics/UI/Gtk/Misc/Calendar.chs" #-}
    (toCalendar self)
    Ptr CUInt
yearPtr
    Ptr CUInt
monthPtr
    Ptr CUInt
dayPtr
  Int
year <- (CUInt -> Int) -> IO CUInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO Int) -> IO CUInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
yearPtr
  Int
month <- (CUInt -> Int) -> IO CUInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO Int) -> IO CUInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
monthPtr
  Int
day <- (CUInt -> Int) -> IO CUInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO Int) -> IO CUInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
dayPtr
  (Int, Int, Int) -> IO (Int, Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
year,Int
month,Int
day)
{-# LINE 282 "./Graphics/UI/Gtk/Misc/Calendar.chs" #-}
--------------------
-- Attributes

-- | The selected year.
--
-- Allowed values: >= 0
--
-- Default value: 0
--
calendarYear :: CalendarClass self => Attr self Int
calendarYear :: forall self. CalendarClass self => Attr self Int
calendarYear = String -> Attr self Int
forall gobj. GObjectClass gobj => String -> Attr gobj Int
newAttrFromIntProperty String
"year"

-- | The selected month (as a number between 0 and 11).
--
-- Allowed values: [0,11]
--
-- Default value: 0
--
calendarMonth :: CalendarClass self => Attr self Int
calendarMonth :: forall self. CalendarClass self => Attr self Int
calendarMonth = String -> Attr self Int
forall gobj. GObjectClass gobj => String -> Attr gobj Int
newAttrFromIntProperty String
"month"

-- | The selected day (as a number between 1 and 31, or 0 to unselect the
-- currently selected day).
--
-- Allowed values: [0,31]
--
-- Default value: 0
--
calendarDay :: CalendarClass self => Attr self Int
calendarDay :: forall self. CalendarClass self => Attr self Int
calendarDay = String -> Attr self Int
forall gobj. GObjectClass gobj => String -> Attr gobj Int
newAttrFromIntProperty String
"day"


-- | Determines whether a heading is displayed.
--
-- Default value: @True@
--
calendarShowHeading :: CalendarClass self => Attr self Bool
calendarShowHeading :: forall self. CalendarClass self => Attr self Bool
calendarShowHeading = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"show-heading"

-- | Determines whether day names are displayed.
--
-- Default value: @True@
--
calendarShowDayNames :: CalendarClass self => Attr self Bool
calendarShowDayNames :: forall self. CalendarClass self => Attr self Bool
calendarShowDayNames = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"show-day-names"

-- | Determines whether the selected month can be changed.
--
-- Default value: @False@
--
calendarNoMonthChange :: CalendarClass self => Attr self Bool
calendarNoMonthChange :: forall self. CalendarClass self => Attr self Bool
calendarNoMonthChange = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"no-month-change"

-- | Determines whether week numbers are displayed.
--
-- Default value: @False@
--
calendarShowWeekNumbers :: CalendarClass self => Attr self Bool
calendarShowWeekNumbers :: forall self. CalendarClass self => Attr self Bool
calendarShowWeekNumbers = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"show-week-numbers"


-- | \'displayOptions\' property. See 'calendarGetDisplayOptions' and
-- 'calendarSetDisplayOptions'
--
--calendarDisplayOptions :: CalendarClass self => Attr self [CalendarDisplayOptions]
--calendarDisplayOptions = newAttr
-- calendarGetDisplayOptions
-- calendarSetDisplayOptions

--------------------
-- Signals

-- | Emitted when a day was selected.
--
onDaySelected, afterDaySelected :: CalendarClass self => self
 -> IO ()
 -> IO (ConnectId self)
onDaySelected :: forall self.
CalendarClass self =>
self -> IO () -> IO (ConnectId self)
onDaySelected = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"day-selected" Bool
False
afterDaySelected :: forall self.
CalendarClass self =>
self -> IO () -> IO (ConnectId self)
afterDaySelected = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"day-selected" Bool
True

-- | Emitted when a day received a double click.
--
onDaySelectedDoubleClick, afterDaySelectedDoubleClick :: CalendarClass self => self
 -> IO ()
 -> IO (ConnectId self)
onDaySelectedDoubleClick :: forall self.
CalendarClass self =>
self -> IO () -> IO (ConnectId self)
onDaySelectedDoubleClick =
  String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"day-selected-double-click" Bool
False
afterDaySelectedDoubleClick :: forall self.
CalendarClass self =>
self -> IO () -> IO (ConnectId self)
afterDaySelectedDoubleClick =
  String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"day-selected-double-click" Bool
True

-- | The month changed.
--
onMonthChanged, afterMonthChanged :: CalendarClass self => self
 -> IO ()
 -> IO (ConnectId self)
onMonthChanged :: forall self.
CalendarClass self =>
self -> IO () -> IO (ConnectId self)
onMonthChanged = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"month-changed" Bool
False
afterMonthChanged :: forall self.
CalendarClass self =>
self -> IO () -> IO (ConnectId self)
afterMonthChanged = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"month-changed" Bool
True

-- | The next month was selected.
--
onNextMonth, afterNextMonth :: CalendarClass self => self
 -> IO ()
 -> IO (ConnectId self)
onNextMonth :: forall self.
CalendarClass self =>
self -> IO () -> IO (ConnectId self)
onNextMonth = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"next-month" Bool
False
afterNextMonth :: forall self.
CalendarClass self =>
self -> IO () -> IO (ConnectId self)
afterNextMonth = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"next-month" Bool
True

-- | The next year was selected.
--
onNextYear, afterNextYear :: CalendarClass self => self
 -> IO ()
 -> IO (ConnectId self)
onNextYear :: forall self.
CalendarClass self =>
self -> IO () -> IO (ConnectId self)
onNextYear = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"next-year" Bool
False
afterNextYear :: forall self.
CalendarClass self =>
self -> IO () -> IO (ConnectId self)
afterNextYear = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"next-year" Bool
True

-- | The previous month was selected.
--
onPrevMonth, afterPrevMonth :: CalendarClass self => self
 -> IO ()
 -> IO (ConnectId self)
onPrevMonth :: forall self.
CalendarClass self =>
self -> IO () -> IO (ConnectId self)
onPrevMonth = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"prev-month" Bool
False
afterPrevMonth :: forall self.
CalendarClass self =>
self -> IO () -> IO (ConnectId self)
afterPrevMonth = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"prev-month" Bool
True

-- | The previous year was selected.
--
onPrevYear, afterPrevYear :: CalendarClass self => self
 -> IO ()
 -> IO (ConnectId self)
onPrevYear :: forall self.
CalendarClass self =>
self -> IO () -> IO (ConnectId self)
onPrevYear = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"prev-year" Bool
False
afterPrevYear :: forall self.
CalendarClass self =>
self -> IO () -> IO (ConnectId self)
afterPrevYear = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"prev-year" Bool
True

foreign import ccall unsafe "gtk_calendar_new"
  gtk_calendar_new :: (IO (Ptr Widget))

foreign import ccall safe "gtk_calendar_select_month"
  gtk_calendar_select_month :: ((Ptr Calendar) -> (CUInt -> (CUInt -> (IO ()))))

foreign import ccall safe "gtk_calendar_select_day"
  gtk_calendar_select_day :: ((Ptr Calendar) -> (CUInt -> (IO ())))

foreign import ccall safe "gtk_calendar_mark_day"
  gtk_calendar_mark_day :: ((Ptr Calendar) -> (CUInt -> (IO ())))

foreign import ccall safe "gtk_calendar_unmark_day"
  gtk_calendar_unmark_day :: ((Ptr Calendar) -> (CUInt -> (IO ())))

foreign import ccall safe "gtk_calendar_clear_marks"
  gtk_calendar_clear_marks :: ((Ptr Calendar) -> (IO ()))

foreign import ccall safe "gtk_calendar_set_display_options"
  gtk_calendar_set_display_options :: ((Ptr Calendar) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_calendar_get_display_options"
  gtk_calendar_get_display_options :: ((Ptr Calendar) -> (IO CInt))

foreign import ccall unsafe "gtk_calendar_get_date"
  gtk_calendar_get_date :: ((Ptr Calendar) -> ((Ptr CUInt) -> ((Ptr CUInt) -> ((Ptr CUInt) -> (IO ())))))