1module Main (main) where
2
3import Graphics.UI.Gtk
4
5{-
6  widgets that go into making a menubar and submenus:
7  * menu item (what the user wants to select)
8  * menu      (acts as a container for the menu items)
9  * menubar   (container for each of the individual menus)
10  menuitem widgets are used for two different things:
11  * they are packed into the menu
12  * they are packed into the menubar, which, when selected, activates the menu
13  Functions:
14  * menuBarNew
15    creates a new menubar, which can be packed into a container like a
16    window or a box
17  * menuNew
18    creates a new menu, which is never actually shown; it is just a
19    container for the menu items
20  * menuItemNew, menuItemNewWithLabel, menuItemMenuWithMnemonic
21    create the menu items that are to be displayed; they are actually
22    buttons with associated actions
23  Once a menu item has been created, it should be put into a menu with
24  the menuShellAppend function.
25  In order to capture when the item is selected by the user, the
26  activate signal need to be connected in the usual way.
27-}
28
29createMenuBar descr
30    = do bar <- menuBarNew
31         mapM_ (createMenu bar) descr
32         return bar
33    where
34      createMenu bar (name,items)
35          = do menu <- menuNew
36               item <- menuItemNewWithLabelOrMnemonic name
37               menuItemSetSubmenu item menu
38               menuShellAppend bar item
39               mapM_ (createMenuItem menu) items
40      createMenuItem menu (name,action)
41          = do item <- menuItemNewWithLabelOrMnemonic name
42               menuShellAppend menu item
43               case action of
44                 Just act -> on item menuItemActivate act
45                 Nothing  -> on item menuItemActivate (return ())
46      menuItemNewWithLabelOrMnemonic name
47          | elem '_' name = menuItemNewWithMnemonic name
48          | otherwise     = menuItemNewWithLabel name
49
50menuBarDescr
51    = [ ("_File", [ ("Open", Nothing)
52                  , ("Save", Nothing)
53                  , ("_Quit", Just mainQuit)
54                  ]
55        )
56      , ("Help",  [ ("_Help", Nothing)
57                  ]
58        )
59      ]
60
61main =
62    do initGUI
63       window <- windowNew
64       menuBar <- createMenuBar menuBarDescr
65       set window [ windowTitle := "Demo"
66                  , containerChild := menuBar
67                  ]
68       on window objectDestroy mainQuit
69       widgetShowAll window
70       mainGUI
71