在Gtk2hs中将MenuItem添加到菜单

时间:2016-03-30 14:11:57

标签: haskell gtk2hs

我想创建一个弹出窗口GTK Menu,然后为其添加一些MenuItems。我找到了这个bit of sample code for popup menus,但它有点被叮咬。固定版本如下。寻找评论"这是不起作用的一点!"。

问题是我显示菜单时没有显示添加的MenuItem。使用UI管理器创建的操作项是在那里,但不是"测试"我手动创建的项目。

我缺少一些步骤吗?或者我是以错误的方式解决这个问题?

import Control.Monad.IO.Class
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"

     window `on` buttonPressEvent $ do
        b <- eventButton
        if b == RightButton
           then do
              liftIO $ menuPopup (castToMenu pop) Nothing
              return True
           else return True


     -- This is the bit that doesn't work!
     testItem <- menuItemNewWithLabel "Test"
     testItem `on` menuItemActivated $ putStrLn "Test clicked"
     menuShellAppend (castToMenu pop) testItem

     mapM_ prAct [eda,pra,rma,saa]

     widgetShowAll window
     window `on` objectDestroy $ 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 = a `on` actionActivated $ do
   name <- actionGetName a
   putStrLn ("Action Name: " ++ name)

1 个答案:

答案 0 :(得分:1)

我已经弄明白了。我需要打电话给#34; widgetShow&#34;在新的菜单项上。

     testItem <- menuItemNewWithLabel "Test"
     widgetShow testItem
     testItem `on` menuItemActivated $ putStrLn "Test clicked"
     menuShellAppend (castToMenu pop) testItem