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
initGUI
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
mainGUI
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.
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
initGUI
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
mainGUI
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>"