7.2 Popup Menus, Radio Actions and Toggle Actions

Menus are normally just added to a window, but they can also be displayed temporarily as the result of a mouse button click. For instance, a context menu might be displayed when the user clicks their right mouse button.

The UI layout for a popup menu should use the popup node. For instance:

uiDecl = "<ui> \
\          <popup>\
\            <menuitem action=\"EDA\" />\
\            <menuitem action=\"PRA\" />\
\            <menuitem action=\"RMA\" />\
\            <separator />\
\            <menuitem action=\"SAA\" />\
\          </popup>\
\        </ui>"   

Constructing a popup menu takes the same steps as a menu or a toolbar (but also see below). Once you've created the actions and put them into one or more groups you create the ui manager, add the XML string and add the groups. Then you extract the widget(s). In the pop up example we've created the 4 actions with the names listed above. The popup menu doesn't show in a screen shot, so we've omitted the picture.

Because it's a popup we don't pack the widget. To show it we need the function:

menuPopup :: MenuClass self => self -> Maybe (MouseButton,TimeStamp)

This is documented in Graphics.UI.Gtk.MenuComboToolbar.Menu in the API documentation. In the example we pop up the menu by clicking the right mouse button, and the second argument can be Nothing. The function is the same as with the event box in Chapter 6.2. Here, however, we can use the window itself instead of an event box.

onButtonPress window (\x -> if (eventButton x) == RightButton
                                    then do menuPopup (castToMenu pop) Nothing
                                            return (eventSent x)
                                    else return (eventSent x))

The only hitch is that the widget returned by the ui manager is of type Widgetand the menuPopupfunction takes an argument of a type which is an instance of MenuClass. So we have to use:

castToMenu :: GObjectClass obj => obj -> Menu

This function is also documented in the Graphics.UI.Gtk.MenuComboToolbar.Menu section. The complete listing of the example is:

import Graphics.UI.Gtk

main :: IO ()
main= do
     window <- windowNew
     set window [windowTitle := "Click Right Popup",
                 windowDefaultWidth := 250,
                 windowDefaultHeight := 150 ]

     eda <- actionNew "EDA" "Edit" Nothing Nothing
     pra <- actionNew "PRA" "Process" Nothing Nothing
     rma <- actionNew "RMA" "Remove" Nothing Nothing
     saa <- actionNew "SAA" "Save" Nothing Nothing

     agr <- actionGroupNew "AGR1" 
     mapM_ (actionGroupAddAction agr) [eda,pra,rma,saa]

     uiman <- uiManagerNew
     uiManagerAddUiFromString uiman uiDecl
     uiManagerInsertActionGroup uiman agr 0

     maybePopup <- uiManagerGetWidget uiman "/ui/popup"
     let pop = case maybePopup of 
                    (Just x) -> x
                    Nothing -> error "Cannot get popup from string"

     onButtonPress window (\x -> if (eventButton x) == RightButton
                                    then do menuPopup (castToMenu pop) Nothing
                                            return (eventSent x)
                                    else return (eventSent x))

     mapM_ prAct [eda,pra,rma,saa]

     widgetShowAll window
     onDestroy window mainQuit

uiDecl = "<ui> \
\          <popup>\
\            <menuitem action=\"EDA\" />\
\            <menuitem action=\"PRA\" />\
\            <menuitem action=\"RMA\" />\
\            <separator />\
\            <menuitem action=\"SAA\" />\
\          </popup>\
\        </ui>"   

prAct :: ActionClass self => self -> IO (ConnectId self)
prAct a = onActionActivate a $ do name <- actionGetName a
                                  putStrLn ("Action Name: " ++ name)

There is another way to use actions, without explicitly creating them, through the ActionEntry datatype:

data ActionEntry = ActionEntry {
actionEntryName :: String
actionEntryLabel :: String
actionEntryStockId :: (Maybe String)
actionEntryAccelerator :: (Maybe String)
actionEntryTooltip :: (Maybe String)
actionEntryCallback :: (IO ())

The use of these fields is as their names indicate and as has been described above and in Chapter 7.1. The actionEntryCallback function must be supplied by the programmer, and will be executed when that particular action is activated.

Add a list of entries to an action group with:

actionGroupAddActions :: ActionGroup -> [ActionEntry] -> IO ()

The group then is inserted using uiManagerInsertActionGroup as before.

Similar functions exist for RadioAction and ToggleAction . Radio actions let the user choose from a number of possibilities, of which only one can be active. Because of this it makes sense to define them all together. The definition is:

data RadioActionEntry = RadioActionEntry {
radioActionName :: String
radioActionLabel :: String
radioActionStockId :: (Maybe String)
radioActionAccelerator :: (Maybe String)
radioActionTooltip :: (Maybe String)
radioActionValue :: Int

The first 5 fields are again used as expected. The radioActionValue identifies each of the possible selections. Addition to a group is done with:

actionGroupAddRadioActions :: 
              ActionGroup -> [RadioActionEntry] -> Int -> (RadioAction -> IO ()) -> IO ()

The Int parameter is the value of the action to activate initially, or -1 for none.

Note: In the example below this appeared to have no effect; the last action is always selected initially.

The function of type (RadioAction -> IO ())is executed whenever that action is activated.

Toggle actions have a Bool value and each may be set or not. The ToggleActionEntry is defined as:

data ToggleActionEntry = ToggleActionEntry {
toggleActionName :: String
toggleActionLabel :: String
toggleActionStockId :: (Maybe String)
toggleActionAccelerator :: (Maybe String)
toggleActionTooltip :: (Maybe String)
toggleActionCallback :: (IO ())
toggleActionIsActive :: Bool

The example below demonstrates the use of toggle actions as well as radio actions.

Note: The toggleActionCallback function has the wrong value on my platform; the workaround is, of course, to use the not function.

RadioAction and ToggleAction

The radio buttons could control a highlight mode, as in the gedit text editor, from which this was copied. The first menu has one button and two sub menus which contain the remaining items. Furthermore, one of the radio buttons is an item in a tool bar. This layout is controlled completely by the first XML definition.

The toggle actions are items in another menu, and two of those are also placed in a toolbar. This layout is determined by the second XML definition.

The interesting thing is that the uiManager can merge these ui definitions just by adding them, as shown below. So you can define your menus in separate modules and easily combine them later in the main module. According to the documentation the ui manager is quite smart at this, and of course you can also use names in the XML definitions to distinguish paths. But recall that the String denoting an action name must be unique for each action.

It is also possible to unmerge menus and toolbars, using the MergeId and the uiManagerRemoveUi function. In this way you can manage menus and toolbars dynamically.

import Graphics.UI.Gtk

main :: IO ()
main= do
     window <- windowNew
     set window [windowTitle := "Radio and Toggle Actions",
                 windowDefaultWidth := 400,
                 windowDefaultHeight := 200 ]
     mhma <- actionNew "MHMA" "Highlight\nMode" Nothing Nothing
     msma <- actionNew "MSMA" "Source"          Nothing Nothing
     mmma <- actionNew "MMMA" "Markup"          Nothing Nothing  

     agr1 <- actionGroupNew "AGR1"
     mapM_ (actionGroupAddAction agr1) [mhma,msma,mmma]
     actionGroupAddRadioActions agr1 hlmods 0 myOnChange

     vima <- actionNew "VIMA" "View" Nothing Nothing          

     agr2 <- actionGroupNew "AGR2"
     actionGroupAddAction agr2 vima
     actionGroupAddToggleActions agr2 togls

     uiman <- uiManagerNew
     uiManagerAddUiFromString uiman uiDef1
     uiManagerInsertActionGroup uiman agr1 0

     uiManagerAddUiFromString uiman uiDef2
     uiManagerInsertActionGroup uiman agr2 1

     mayMenubar <- uiManagerGetWidget uiman "/ui/menubar"
     let mb = case mayMenubar of 
                    (Just x) -> x
                    Nothing -> error "Cannot get menu bar."

     mayToolbar <- uiManagerGetWidget uiman "/ui/toolbar"
     let tb = case mayToolbar of 
                    (Just x) -> x
                    Nothing -> error "Cannot get tool bar."

     box <- vBoxNew False 0
     containerAdd window box
     boxPackStart box mb PackNatural 0
     boxPackStart box tb PackNatural 0

     widgetShowAll window
     onDestroy window mainQuit

hlmods :: [RadioActionEntry]
hlmods = [
     RadioActionEntry "NOA" "None"    Nothing Nothing Nothing 0,   
     RadioActionEntry "SHA" "Haskell" (Just stockHome)  Nothing Nothing 1, 
     RadioActionEntry "SCA" "C"       Nothing Nothing Nothing 2,
     RadioActionEntry "SJA" "Java"    Nothing Nothing Nothing 3,
     RadioActionEntry "MHA" "HTML"    Nothing Nothing Nothing 4,
     RadioActionEntry "MXA" "XML"     Nothing Nothing Nothing 5]

myOnChange :: RadioAction -> IO ()
myOnChange ra = do val <- radioActionGetCurrentValue ra
                   putStrLn ("RadioAction " ++ (show val) ++ " now active.")

uiDef1 = " <ui> \
\           <menubar>\
\              <menu action=\"MHMA\">\
\                 <menuitem action=\"NOA\" />\
\                 <separator />\
\                 <menu action=\"MSMA\">\
\                    <menuitem action= \"SHA\" /> \
\                    <menuitem action= \"SCA\" /> \
\                    <menuitem action= \"SJA\" /> \
\                 </menu>\
\                 <menu action=\"MMMA\">\
\                    <menuitem action= \"MHA\" /> \
\                    <menuitem action= \"MXA\" /> \
\                 </menu>\
\              </menu>\
\           </menubar>\
\            <toolbar>\
\              <toolitem action=\"SHA\" />\
\            </toolbar>\
\           </ui> "            

togls :: [ToggleActionEntry]
togls = let mste = ToggleActionEntry "MST" "Messages" Nothing Nothing Nothing (myTog mste) False   
            ttte = ToggleActionEntry "ATT" "Attributes" Nothing Nothing Nothing (myTog ttte)  False 
            erte = ToggleActionEntry "ERT" "Errors" (Just stockInfo) Nothing Nothing (myTog erte)  True 
        in [mste,ttte,erte]

myTog :: ToggleActionEntry -> IO ()
myTog te = putStrLn ("The state of " ++ (toggleActionName te) 
                      ++ " (" ++ (toggleActionLabel te) ++ ") " 
                      ++ " is now " ++ (show $ not (toggleActionIsActive te)))
uiDef2 = "<ui>\
\          <menubar>\
\            <menu action=\"VIMA\">\
\             <menuitem action=\"MST\" />\
\             <menuitem action=\"ATT\" />\
\             <menuitem action=\"ERT\" />\
\            </menu>\
\          </menubar>\
\            <toolbar>\
\              <toolitem action=\"MST\" />\
\              <toolitem action=\"ERT\" />\
\            </toolbar>\
\         </ui>"