如何在 Mac OS X 中处理 Haskell gtk2hs 中的退出命令 (Cmd-Q)

Question

我正在试验 https://github.com/gtk2hs/gtk2hs/blob/master/gtk/demo/hello/World.hs 上的示例程序，转载如下：

-- A simple program to demonstrate Gtk2Hs.
module Main (Main.main) where

import Graphics.UI.Gtk

main :: IO ()
main = do
  initGUI
  -- Create a new window
  window <- windowNew
  -- Here we connect the "destroy" event to a signal handler.
  -- This event occurs when we call widgetDestroy on the window
  -- or if the user closes the window.
  on window objectDestroy mainQuit
  -- Sets the border width and tile of the window. Note that border width
  -- attribute is in 'Container' from which 'Window' is derived.
  set window [ containerBorderWidth := 10, windowTitle := "Hello World" ]
  -- Creates a new button with the label "Hello World".
  button <- buttonNew
  set button [ buttonLabel := "Hello World" ]
  -- When the button receives the "clicked" signal, it will call the
  -- function given as the second argument.
  on button buttonActivated (putStrLn "Hello World")
  -- Gtk+ allows several callbacks for the same event.
  -- This one will cause the window to be destroyed by calling
  -- widgetDestroy. The callbacks are called in the sequence they were added.
  on button buttonActivated $ do
    putStrLn "A \"clicked\"-handler to say \"destroy\""
    widgetDestroy window
  -- Insert the hello-world button into the window.
  set window [ containerChild := button ]
  -- The final step is to display this newly created widget. Note that this
  -- also allocates the right amount of space to the windows and the button.
  widgetShowAll window
  -- All Gtk+ applications must have a main loop. Control ends here
  -- and waits for an event to occur (like a key press or mouse event).
  -- This function returns if the program should finish.
  mainGUI

如果我在 Mac OS X 上构建并运行这个，Cmd-Q 或应用程序菜单中的退出命令不会关闭应用程序。我如何捕获此事件并使其关闭应用程序？

更新

我已经向我的项目添加了一个 gtk3-mac-integration 依赖项，向我的源文件添加了一个 import Graphics.UI.Gtk.OSX 并且在调用 initGUI 之后立即添加了以下内容：

app <- applicationNew
on app willTerminate (return ())

我肯定遗漏了一些东西，因为这似乎没有任何作用（参见 https://github.com/rcook/gtkapp/commit/8531509d0648ddb657633a33773c09bc5a576014）。

更新编号2

感谢@Jack Henahan 和 OSXDemo.hs，我现在有了一个可行的解决方案：

-- A simple program to demonstrate Gtk2Hs.
module Main (Main.main) where

import Control.Exception
import Control.Monad
import Graphics.UI.Gtk
import Graphics.UI.Gtk.OSX

showDialog :: Window -> String -> String -> IO ()
showDialog window title message = bracket
    (messageDialogNew (Just window) [] MessageInfo ButtonsOk message)
    widgetDestroy
    (\d -> do
        set d [ windowTitle := title ]
        void $ dialogRun d)

main :: IO ()
main = do
    void initGUI

    -- Create a new window
    window <- windowNew

    -- Here we connect the "destroy" event to a signal handler.
    -- This event occurs when we call widgetDestroy on the window
    -- or if the user closes the window.
    void $ on window objectDestroy mainQuit

    -- Sets the border width and tile of the window. Note that border width
    -- attribute is in 'Container' from which 'Window' is derived.
    set window [ containerBorderWidth := 10, windowTitle := "Hello World" ]

    -- Creates a new button with the label "Hello World".
    button <- buttonNew
    set button [ buttonLabel := "Hello World" ]

    -- When the button receives the "clicked" signal, it will call the
    -- function given as the second argument.
    void $ on button buttonActivated (putStrLn "Hello World")

    void $ on button buttonActivated $ showDialog window "THE-TITLE" "THE-MESSAGE"

    -- Gtk+ allows several callbacks for the same event.
    -- This one will cause the window to be destroyed by calling
    -- widgetDestroy. The callbacks are called in the sequence they were added.
    void $ on button buttonActivated $ do
        putStrLn "A \"clicked\"-handler to say \"destroy\""
        widgetDestroy window

    -- Insert the hello-world button into the window.
    set window [ containerChild := button ]

    -- The final step is to display this newly created widget. Note that this
    -- also allocates the right amount of space to the windows and the button.
    widgetShowAll window

    app <- applicationNew

    -- blockTermination: return True to prevent quit, False to allow
    on app blockTermination $ do
        putStrLn "blockTermination"
        return False

    -- willTerminate: handle clean-up etc.
    on app willTerminate $ do
        putStrLn "willTerminate"

    menuBar <- menuBarNew
    applicationSetMenuBar app menuBar
    applicationReady app

    -- All Gtk+ applications must have a main loop. Control ends here
    -- and waits for an event to occur (like a key press or mouse event).
    -- This function returns if the program should finish.
    mainGUI

Answer 1

您需要发送一个 NSApplicationWillTerminate 信号。

willTerminate :: ApplicationClass self => Signal self (IO ())
willTerminate = Signal (connect_NONE__NONE "NSApplicationWillTerminate")

是gtk-mac-integration中的处理方式。

如何在 Mac OS X 中处理 Haskell gtk2hs 中的退出命令 (Cmd-Q)

How to handle Quit command (Cmd-Q) in Mac OS X in Haskell gtk2hs

haskell

gtk2hs