haskellgtk2hs

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


I'm experimenting with the sample program at https://github.com/gtk2hs/gtk2hs/blob/master/gtk/demo/hello/World.hs, reproduced below:

-- 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

If I build and run this on Mac OS X, Cmd-Q or the Quit command from the app's menu does not close the application. How do I trap this event and cause it to close the app?

Update

I've added a gtk3-mac-integration dependency to my project, an import Graphics.UI.Gtk.OSX to my source file and the following immediately after calling initGUI:

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

I'm definitely missing something as this doesn't seem to do anything (see https://github.com/rcook/gtkapp/commit/8531509d0648ddb657633a33773c09bc5a576014).

Update no. 2

Thanks to @Jack Henahan and OSXDemo.hs, I now have a working solution:

-- 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

Solution

  • You need to send an NSApplicationWillTerminate signal.

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

    is how it's handled in gtk-mac-integration.