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