-- | This module implements a very simple text-based clock widget. -- The widget also toggles a calendar widget when clicked. This -- calendar is not fancy at all and has no data backend. module System.Taffybar.SimpleClock ( textClockNew ) where import Control.Monad.Trans ( MonadIO, liftIO ) import Data.Time.Format import Data.Time.LocalTime import Graphics.UI.Gtk import System.Locale import System.Taffybar.Widgets.PollingLabel getCurrentTime :: TimeLocale -> String -> IO String getCurrentTime timeLocale fmt = do zt <- getZonedTime return $ formatTime timeLocale fmt zt makeCalendar :: IO Window makeCalendar = do container <- windowNew cal <- calendarNew containerAdd container cal return container toggleCalendar w c = liftIO $ do isVis <- get c widgetVisible case isVis of True -> widgetHideAll c False -> do windowSetKeepAbove c True windowStick c windowSetTypeHint c WindowTypeHintTooltip windowSetSkipTaskbarHint c True windowSetSkipPagerHint c True Just topLevel <- widgetGetAncestor w gTypeWindow let topLevelWindow = castToWindow topLevel windowSetTransientFor c topLevelWindow widgetShowAll c return True -- | Create the widget. I recommend passing @Nothing@ for the -- TimeLocale parameter. The format string can include Pango markup -- (http://developer.gnome.org/pango/stable/PangoMarkupFormat.html). textClockNew :: Maybe TimeLocale -- ^ An TimeLocale - if not specified, the default is used. This can be used to customize how different aspects of time are localized -> String -- ^ The time format string (see http://www.haskell.org/ghc/docs/6.12.2/html/libraries/time-1.1.4/Data-Time-Format.html) -> Double -- ^ The number of seconds to wait between clock updates -> IO Widget textClockNew userLocale fmt updateSeconds = do let timeLocale = maybe defaultTimeLocale id userLocale -- Use a label to display the time. Since we want to be able to -- click on it to show a calendar, we need an eventbox wrapper to -- actually receive events. l <- pollingLabelNew "" updateSeconds (getCurrentTime timeLocale fmt) -- l <- labelNew Nothing ebox <- eventBoxNew containerAdd ebox l eventBoxSetVisibleWindow ebox False -- Allocate a hidden calendar and just show/hide it on clicks. cal <- makeCalendar _ <- on ebox buttonPressEvent (toggleCalendar l cal) widgetShowAll ebox -- The widget in the bar is actuall the eventbox return (toWidget ebox)