{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | Implementation of 'Gtk.Notebook' as a declarative container. module GI.Gtk.Declarative.Container.Notebook ( Page , page , pageWithTab , notebook ) where import Control.Monad (void) import Data.Maybe (isNothing) import Data.Text (Text, pack) import Data.Vector (Vector) import GHC.Ptr (nullPtr) import qualified GI.GLib as GLib import qualified GI.Gtk as Gtk import GI.Gtk.Declarative.Attributes import GI.Gtk.Declarative.Container import GI.Gtk.Declarative.Container.Class import GI.Gtk.Declarative.SingleWidget import GI.Gtk.Declarative.Widget -- | Describes a page to be added to a 'Notebook' data Page event = Page { tabLabel :: Widget event , child :: Widget event } -- | Create a page with a textual label and an arbitrary content widget. page :: Text -> Widget event -> Page event page label = pageWithTab (widget Gtk.Label [#label := label]) -- | Create a page with arbitrary widgets for both label and content. pageWithTab :: Widget event -> Widget event -> Page event pageWithTab = Page -- | Create a 'Notebook' by combining multiple pages. notebook :: Vector (Attribute Gtk.Notebook event) -> Vector (Page event) -> Widget event notebook attrs children = let childrenAndTabs = children >>= (\Page {..} -> [child, tabLabel]) in container Gtk.Notebook attrs childrenAndTabs instance ToChildren Gtk.Notebook Vector Widget instance IsContainer Gtk.Notebook Widget where appendChild parent _ new = do lastPage <- Gtk.notebookGetNthPage parent (-1) case lastPage of Nothing -- this is the first page to be added -> do void $ Gtk.notebookAppendPage parent new (Nothing :: Maybe Gtk.Widget) Just p -> do label <- Gtk.notebookGetTabLabel parent p if isNothing label -- this page must already have a child, we just need to set the label then do Gtk.notebookSetTabLabel parent p (Just new) else do void $ Gtk.notebookAppendPage parent new (Nothing :: Maybe Gtk.Widget) replaceChild parent _ i old new = do let i' = i `div` 2 pageI <- Gtk.notebookGetNthPage parent i' case pageI of Nothing -> do GLib.logDefaultHandler (Just "gi-gtk-declarative") [GLib.LogLevelFlagsLevelError] (Just $ "GI.Gtk.Declarative.Container.Notebook.replaceChild called with an index where there is no child: " <> pack (show i)) nullPtr Just p -> do if i `mod` 2 == 0 then do label <- Gtk.notebookGetTabLabel parent p -- we have to replace the child Gtk.widgetDestroy old void $ Gtk.notebookInsertPage parent new label i' else do Gtk.notebookSetTabLabel parent p (Just new) -- we have to replace the label