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