Window.hs

module Graphics.UI.Sifflet.Window
    (
     -- Window utilities
      getOrCreateWindow
    , showWindow
    , newWindowTitled

    , showWorkWin
    , showWorkspaceWindow

    , showFedWin
    , fedWindowTitle

    , getOrCreateFunctionPadWindow
    , showFunctionPadWindow
    , newFunctionDialog

    , openFilePath
    , setWSCanvasCallbacks
    , keyBindingsHelpText
    )

where

-- debug imports
-- import Debug.Trace

-- standard imports

import Control.Monad
import Data.IORef
import Data.List as List
import Data.Map as Map (fromList, keys, lookup)
import Data.Map (Map)
import Data.Maybe
import Data.Text (Text, pack)

import Data.Graph.Inductive as G
import Data.Version

import Graphics.Rendering.Cairo
import Graphics.UI.Gtk.Gdk.EventM

import System.FilePath

-- sifflet imports

import Data.Sifflet.Functoid
import Data.Sifflet.Geometry
import Data.Sifflet.WGraph

import Language.Sifflet.Export.Exporter
import Language.Sifflet.Export.ToHaskell (defaultHaskellOptions, exportHaskell)
import Language.Sifflet.Export.ToPython (defaultPythonOptions, exportPython)
import Language.Sifflet.Export.ToScheme (SchemeOptions(..), exportScheme)

import Language.Sifflet.Expr
import Language.Sifflet.SiffML

import Graphics.UI.Sifflet.Frame
import Graphics.UI.Sifflet.Canvas
import Graphics.UI.Sifflet.Types
import Graphics.UI.Sifflet.Callback
import Graphics.UI.Sifflet.Tool
import Graphics.UI.Sifflet.Workspace
import Graphics.UI.Sifflet.GtkForeign
import Graphics.UI.Sifflet.GtkUtil
import Graphics.UI.Sifflet.LittleGtk
import Graphics.UI.Sifflet.RPanel

import Language.Sifflet.Util


import Paths_sifflet as Paths

-- ---------------------------------------------------------------------
-- | Finding, creating, and initializing windows (VPUIWindow)

-- | Find and show a window, if it exists.
--   If not, create the window, put it in the vpui's window map,
--   and initialize it and any auxiliary objects using the initWin function.
--   The 3rd argument of initWin will be the window's title.
-- Always presents the window (shows and raises).
-- Returns a 3-tuple: the VPUIWindow contains the Window,
-- and the Bool value is True if the Window is new
-- (and therefore might need some further initialization).
-- The third tuple element is an IORef to the VPUIWindow;
-- it may be useful for setting up signal and event handling.

showWindow :: WinId -> CBMgr
           -> (VPUI -> Window -> IO VPUIWindow) -- initializes Gtk Window
           -> (VPUI -> WinId -> CBMgr -> IO ()) -- initializes callbacks
           -> VPUI -> IO (VPUI, VPUIWindow, Bool)
showWindow winId uimgr initWin initCB vpui =
  getOrCreateWindow winId uimgr initWin initCB True vpui

-- | Like showWindow, except that making the window visible is optional
getOrCreateWindow  :: WinId -> CBMgr
                   -> (VPUI -> Window -> IO VPUIWindow) 
                      -- ^ initialize Gtk Window
                   -> (VPUI -> WinId -> CBMgr -> IO ())
                      -- ^ initialize callbacks
                   -> Bool -- ^ make window visible
                   -> VPUI -> IO (VPUI, VPUIWindow, Bool)
getOrCreateWindow winId uimgr initWin initCB visible vpui = do
  (vpui', vw, isNew) <- 
      case vpuiTryGetWindow vpui winId of
        Nothing -> do
          window <- newWindowTitled winId
          widgetSetName window ("Sifflet-" ++ winId)
          vwin <- initWin vpui window
          let vpui' = vpuiInsertWindow vpui winId vwin
          uimgr (OnWindowDestroy window (onWindowDestroy winId))
          return (vpui', vwin, True)
        Just vw ->
            return (vpui, vw, False)
  when isNew (initCB vpui' winId uimgr) -- add callbacks on new window
  when visible $
       -- show it
       let window = vpuiWindowWindow vw
       in do
         widgetShowAll window
         windowPresent window
  return (vpui', vw, isNew)

onWindowDestroy :: WinId -> IORef VPUI -> IO ()
onWindowDestroy winId uiref =
  if (winId == workspaceId) 
  then 
      readIORef uiref >>=
      checkForChanges "quit (by closing the workspace window)" True False
                          (\ vpui -> do { mainQuit; return vpui }) >>
      return ()
  else modifyIORef uiref (vpuiRemoveVPUIWindow winId)

-- | Default "do-nothing" add-callbacks function
initCBDefault :: VPUI -> WinId -> CBMgr -> IO ()
initCBDefault _vpui _winId _uimgr = return ()

newWindowTitled :: String -> IO Window
newWindowTitled winId = do
  window <- windowNew
  set window [windowTitle := winId]
  widgetSetName window ("Sifflet-" ++ winId)
  return window

-- | Show a workspace window, with a given title, _not_ editing a function

showWorkWin :: VPUI -> WinId -> CBMgr -> IO VPUI
showWorkWin vpui winId uimgr = do
  {
    (vpui', _, _) <- showWorkspaceWindow winId uimgr Nothing vpui
  ; return vpui'
  }

-- | Show a workspace window with a given title and maybe function to edit

showWorkspaceWindow :: WinId -> CBMgr -> Maybe Function -> VPUI
                    -> IO (VPUI, VPUIWindow, Bool)
showWorkspaceWindow winId cbmgr mfunc =
    showWindow winId cbmgr (workspaceWindowInit cbmgr winId mfunc) 
               setWSCanvasCallbacks


-- | Initialize a Workspace window.
-- Called in sifflet.hs:Main from showWindow called from showWorkspaceWindow.

workspaceWindowInit :: CBMgr -> WinId -> Maybe Function -> VPUI -> Window
                    -> IO VPUIWindow
workspaceWindowInit cbmgr winId mfunc vpui window = do
  {
    let style = vpuiStyle vpui
        env = vpuiGlobalEnv vpui
  ; ws <- case mfunc of 
            Nothing -> workspaceNewDefault style (buildMainMenu cbmgr)
            Just func -> workspaceNewEditing style env func
  ; set window [windowTitle := winId, containerChild := wsRootWidget ws]
                -- this should suppress the window close button,
                -- but doesn't, at least in Fluxbox
                -- windowDeletable := False] -- no close button
  ; widgetShowAll window
  ; windowPresent window

  ; return $ VPUIWorkWin ws window
  }

-- Menu specs here need to coordinate accelerators (shortcuts)
-- with keyBindingsList in WindowManagement.hs

buildMainMenu :: CBMgr -> VBox -> IO ()
buildMainMenu cbmgr vbox = do
  {
    -- menu bar 
    let mspecs = 
            [MenuSpec "File"
                      [ -- "new" isn't implemented yet
                        -- MenuItem "New ..." menuFileNew
                        -- , 
                        -- Temporarily disabling file I/O operations
                        MenuItem "Open ...     (C-o)" (menuFileOpen cbmgr)
                      , MenuItem "Save         (C-s)" menuFileSave
                      , MenuItem "Save as ..." menuFileSaveAs
                      , MenuItem "Export to Haskell ..." 
                                 menuFileExportHaskell
                      , MenuItem "Export to Python3 ..." menuFileExportPython
                      , MenuItem "Export to Scheme ..." menuFileExportScheme
                      , MenuItem "Save image ..." menuFileSaveImage
                      , MenuItem "Quit         (C-q)" menuFileQuit]
            , MenuSpec "Functions"
                       [MenuItem "New ...      (n)"
                                  (newFunctionDialog "ignore" cbmgr)
                       , MenuItem "Function Pad"
                                  (showFunctionPadWindow cbmgr)]
            , MenuSpec "Help"
                       [MenuItem "Help ..." showHelpDialog
                       , MenuItem "Complaints and praise ..." showBugs
                       , MenuItem "About ..." showAboutDialog]
             ]
  ; menubar <- createMenuBar mspecs cbmgr
  ; boxPackStart vbox menubar PackNatural 0
}

-- | Show a function editor window = a workspace window editing a given function.
-- Use argNames for a new function; ignore them if funcName is bound.

showFedWin :: CBMgr -> String -> [String] -> VPUI -> IO VPUI
showFedWin cbmgr funcName argNames vpui = do
  {
    let initEnv = vpuiGlobalEnv vpui
        function = case envLookupFunction initEnv funcName of
                     Nothing -> newUndefinedFunction funcName argNames
                     Just func -> func
        winId = fedWindowTitle funcName

  ; (vpui', vw, isNew) <- showWorkspaceWindow winId cbmgr (Just function) vpui

  ; if isNew
    then do
      {
        let canvas = vpuiWindowGetCanvas vw
      ; canvas' <- vcAddFrame canvas (FunctoidFunc function) 
                   Nothing EditFrame
                   initEnv 0 0 0 Nothing
      ; canvas'' <- 
          case vcFrames canvas' of
            [] -> info "showFedWin: ERROR: no frame on canvas" >> 
                  return canvas'
            _:_:_ -> 
                info "showFedWin: ERROR: too many frames on canvas" >> 
                return canvas'
            [frame] -> editFunction canvas' frame 
      ; addFedWinButtons cbmgr winId vpui'
      ; return (vpuiReplaceWindow vpui' winId 
                                  (vpuiWindowSetCanvas vw canvas''))
      }
    else return vpui'
  }

fedWindowTitle :: String -> WinId
fedWindowTitle funcName = "Edit " ++ funcName

updateFunctionPadIO :: String -> (RPanel -> IO RPanel) -> VPUI -> IO VPUI
updateFunctionPadIO padName update =
    let updateWindow vw =
            case vw of
              FunctionPadWindow window rpAList ->
                  do
                    {
                      rpAList' <- adjustAListM padName update rpAList
                    ; return (FunctionPadWindow window rpAList')
                    }
              _ -> return vw
    in vpuiUpdateWindowIO "Function Pad" updateWindow

-- | Show the function pad window; create it if needed
showFunctionPadWindow :: CBMgr -> VPUI -> IO VPUI
showFunctionPadWindow cbmgr vpui = getOrCreateFunctionPadWindow cbmgr True vpui

-- | Create the function pad window if it doesn't exist
getOrCreateFunctionPadWindow :: CBMgr -> Bool -> VPUI -> IO VPUI
getOrCreateFunctionPadWindow cbmgr visible vpui = 
    let initWindow _vpui window = do
          vbox <- vBoxNew False 0 -- non-homogenous, 0 padding
          set window [containerChild := vbox]
          let rpnames = ["Base", "Examples", "My Functions"]
          rps <- mapM (makeFunctionPadPanel cbmgr vpui) rpnames
          mapM_ (\ rp -> boxPackStart vbox (rpanelRoot rp) PackNatural 0)
                rps
          windowMove window 5 5
          return $ FunctionPadWindow window (zip rpnames rps) 
           -- maybe need reference only the "My Functions" panel though **
    in do
      (vpui', _, windowIsNew) <- getOrCreateWindow functionPadWinId 
                                     cbmgr initWindow initCBDefault visible vpui
      -- "My Functions" default is empty; add any user-defined
      -- functions in the environment to it
      if windowIsNew
          then addUserFunctions cbmgr vpui'
          else return vpui'


functionPadWinId :: String
functionPadWinId = "Function Pad"

addUserFunctions :: CBMgr -> VPUI -> IO VPUI
addUserFunctions cbmgr vpui =
    let names = map fst (vpuiUserEnvAList vpui)
        update rp = do
          {
            buttons <- mapM (makeToolButton cbmgr . functionTool) names
          ; rp' <- rpanelAddWidgets rp (zip names buttons)
          ; widgetShowAll (rpanelRoot rp')
          ; return rp'
          }      
    in updateFunctionPadIO "My Functions" update vpui

makeFunctionPadPanel :: CBMgr -> VPUI -> String -> IO RPanel
makeFunctionPadPanel cbmgr vpui name =
    let VPToolkit _ width toolrows = 
            case List.lookup name (vpuiToolkits vpui) of
              Nothing ->
                  errcats ["makeFunctionPadPanel:",
                           "can't find toolkit definition:", name]
              Just atoolkit -> atoolkit
    in do
      {
        buttonRows <- makeToolButtonRows cbmgr toolrows
                      :: IO [[(String, Button)]]
      ; rp <- newRPanel name 3 3 width
      ; rpanelAddRows rp buttonRows
      }

makeToolButtonRows :: CBMgr -> [[Tool]] -> IO [[(String, Button)]]
makeToolButtonRows cbmgr toolRows = 
    mapM2 (makeNamedToolButton cbmgr) toolRows

makeNamedToolButton :: CBMgr -> Tool -> IO (String, Button)
makeNamedToolButton cbmgr tool = do
  {
    button <- makeToolButton cbmgr tool
  ; return (toolName tool, button)
  }

makeToolButton :: CBMgr -> Tool -> IO Button
makeToolButton cbmgr tool = do
  {
    button <- buttonNewWithLabel (toolName tool)
  ; cbmgr (AfterButtonClicked button
           (modifyIORefIO (forallWindowsIO (vpuiWindowSetTool tool))))
  ; return button
  }

-- | Add a tool button to the function pad window in a specified panel
addFunctionPadToolButton :: CBMgr -> String -> Tool -> VPUIWindow 
                         -> IO VPUIWindow
addFunctionPadToolButton cbmgr panelId tool vw = 
    case vw of
      FunctionPadWindow window panelAList ->
          let adjustPanel :: RPanel -> IO RPanel
              adjustPanel rp = do
                {
                  -- make the tool button from the tool
                  button <- makeToolButton cbmgr tool
                  -- add it to the panel
                ; rp' <- rpanelAddWidget rp (toolName tool) button
                ; widgetShowAll (rpanelRoot rp')
                ; return rp'
                }
          in do
            {
              panelAList' <- adjustAListM panelId adjustPanel panelAList
            ; return $ FunctionPadWindow window panelAList'
            }
      _ -> return vw


-- | Ask user for new function name and arguments,
-- then begin editing the function.

newFunctionDialog :: WinId -> CBMgr -> VPUI -> IO VPUI
newFunctionDialog _winId cbmgr vpui =
    -- _winId is ignored, but needed for use in KeyBindingsList
  let reader :: Reader [String] (String, [String])
      reader inputLines =
          case inputLines of
            [fname, fargs] ->
                return (fname, words fargs)
            _ -> fail "wrong number of lines"
  in do
    {
      inputDialog <- 
          createEntryDialog "New Function"
                            ["Function name", "Argument names (space between)"]
                            ["", ""]
                            reader
                            (-1)
    ; values <- runEntryDialog inputDialog
    ; case values of
        Nothing -> return vpui
        Just (name, args) -> editNewFunction cbmgr name args vpui
    }

-- ------------------------------------------------------------
-- Implementation of menu commands

-- -- | Create a new file, but what does this mean?

-- menuFileNew :: VPUI -> IO VPUI
-- menuFileNew vpui = putStrLn "Not implemented: \"New\"" >> return vpui
-- -- Notes for future implementation:
-- --     checkChangesAndContinue vpui ...


-- | Quit from Sifflet

menuFileQuit :: VPUI -> IO VPUI
menuFileQuit = checkForChanges "quit" False True vpuiQuit

-- | Open a file (load its function definitions)

menuFileOpen :: CBMgr -> VPUI -> IO VPUI
menuFileOpen cbmgr =
    checkForChanges "open file" True True (continueFileOpen cbmgr)

-- | Offer to save changes, if any, and continue with the continuation.
-- The continuation gets the current vpui if there are no changes
-- or if the offer to save is rejected; otherwise, it gets a
-- vpui which knows it has saved its last changes.
-- If offerCancel is true, there is an option to cancel the operation;
-- this won't work if the user is closing the main (workspace) window.
-- The message, if any, is a confirmation that the file was
-- saved and that we are going on to the next operation --
-- useful for open file, but not for quit.

checkForChanges :: String -> Bool -> Bool -> (VPUI -> IO VPUI) 
                -> VPUI -> IO VPUI
checkForChanges beforeOperation acknowledge offerCancel continue vpui =
    let mAckIfSaved vpui' = 
            when (not (vpuiFileChanged vpui') && acknowledge)
                 (
                  showInfoMessage "Changes saved" 
                                  ("Your changes are now saved; " ++
                                   "proceeding to " ++
                                   beforeOperation ++ ".")
                 ) 
            >>
            return vpui'
        choices = [("Save them", 
                    menuFileSave vpui >>= mAckIfSaved >>= continue),
                   ("Throw them away", 
                    return vpui >>= continue)] ++ 
                  if offerCancel
                  then [("Cancel " ++ beforeOperation, return vpui)]
                  else []
        labels = map fst choices
        actions = map snd choices
        offerSaveAndContinue = showChoicesDialog "Save changes?"
                               ("There are unsaved changes.  " ++
                                "Before you " ++ beforeOperation ++
                                ", would you ...")
                               labels
                               actions
                               (return vpui)
    in if vpuiFileChanged vpui
       then offerSaveAndContinue
       else continue vpui

-- | Continue with opening the file, after having possibly saved changes
continueFileOpen :: CBMgr -> VPUI -> IO VPUI
continueFileOpen cbmgr vpui = do
  mpath <- showDialogFileOpen vpui
  case mpath of
    Nothing -> return vpui
    Just filePath -> openFilePath cbmgr filePath vpui

-- | Now that we have a file path, go ahead and open it,
-- loading the function definitions into Sifflet
-- and adding buttons to the function pad "My Functions" area.

openFilePath :: CBMgr -> FilePath -> VPUI -> IO VPUI
openFilePath cbmgr filePath vpui = do
  loadResult <- loadFile vpui filePath
  case loadResult of
    Fail msg ->
        showErrorMessage msg >> return vpui
    Succ (vpui', functions) -> 
        let title = "My Functions"
            updatePad rp =
                -- Figure out which functions are new,
                -- i.e., not already on the pad
                let oldNames = concat (rpanelContent rp)
                    loadedNames = map functionName functions
                    -- use set difference to avoid duplicates
                    newNames = loadedNames \\ oldNames
                    newTools = map functionTool newNames
                in do 
                  newPairs <- mapM (makeNamedToolButton cbmgr) newTools
                  rp' <- rpanelAddWidgets rp newPairs
                  widgetShowAll (rpanelRoot rp)
                  return rp'

        in do
          vpui'' <- 
              getOrCreateFunctionPadWindow cbmgr False vpui' >>=
              updateFunctionPadIO title updatePad 
          setWorkspaceTitleForFile vpui'' filePath
          return $ vpui'' {vpuiCurrentFile = Just filePath, 
	  	   	   vpuiCurrentDir = takeDirectory filePath,
                           vpuiFileEnv = vpuiGlobalEnv vpui'}

setWorkspaceTitleForFile :: VPUI -> FilePath -> IO ()
setWorkspaceTitleForFile vpui filePath =
  case vpuiTryGetWindow vpui workspaceId of
    Just (VPUIWorkWin _ window) ->
      -- show file name in workspace window title
      set window [windowTitle := 
                  workspaceId ++ ": " ++ takeFileName filePath]
    _ -> return ()

showDialogFileOpen :: VPUI -> IO (Maybe FilePath)
showDialogFileOpen vpui = do
  chooser <- fileChooserDialogNew
               (Just "Open file ...")          -- default title
               Nothing          -- transient parent of the dialog
               FileChooserActionOpen
               [("Open", ResponseOk), ("Cancel", ResponseCancel)] -- buttons
  _ <- fileChooserSetCurrentFolder chooser (vpuiCurrentDir vpui)
  result <- runDialogM (toDialog chooser) chooser fileChooserGetFilename
  return result

loadFile :: VPUI -> FilePath -> IO (SuccFail (VPUI, [Function]))
loadFile vpui filePath = do
  {
    functions <- consumeSiffMLFile xmlToFunctions filePath
  ; case functions of
      [Functions fs] ->
          let vpui' = foldl bindFunction vpui fs
          in return (Succ (vpui', fs))
      _ ->
          return (Fail "file format error")

  }

bindFunction :: VPUI -> Function -> VPUI
bindFunction vpui function =
    let env = vpuiGlobalEnv vpui
        Function (Just name) _argTypes _resType _impl = function
        env' = envIns env name (VFun function)
    in vpui {vpuiGlobalEnv = env'}

-- | Implements File menu "Save" command.

menuFileSave :: VPUI -> IO VPUI
menuFileSave vpui = 
    case vpuiCurrentFile vpui of
      Nothing -> menuFileSaveAs vpui
      Just filePath -> saveFile vpui filePath

-- | Implements File menu "Save as" command.
menuFileSaveAs :: VPUI -> IO VPUI
menuFileSaveAs vpui = do
  {
    mFilePath <- chooseOutputFile "Save" vpui
  ; case mFilePath of
      Nothing -> return vpui
      Just filePath -> saveFile vpui filePath
  }

-- | Unconditionally save user functions in SiffML file.
-- Called from menuFileSave and menuFileSaveAs.
-- Updates vpuiCurrentFile and vpuiFileEnv.
saveFile :: VPUI -> FilePath -> IO VPUI
saveFile vpui filePath =
    produceSiffMLFile (userFunctions vpui) filePath >>
    setWorkspaceTitleForFile vpui filePath >>
    return vpui {vpuiCurrentFile = Just filePath, 
    	   	 vpuiCurrentDir = takeDirectory filePath, 
                 vpuiFileEnv = vpuiGlobalEnv vpui}

-- | The user-defined functions of the environment
userFunctions :: VPUI -> Functions
userFunctions vpui = 
    Functions (map (valueFunction . snd) 
                   (vpuiUserEnvAList vpui))

-- | Export user functions to a file,
-- given an exporter and a path,
-- returning the vpui unchanged.
maybeExportUserFunctions :: VPUI -> (opts -> Exporter) 
                         -> Maybe (FilePath, opts) -> IO VPUI
maybeExportUserFunctions vpui export mpathOptions =
    case mpathOptions of
      Nothing -> return vpui 
      Just (path, options) -> 
          export options (userFunctions vpui) path >> 
          return (vpui {vpuiCurrentDir = takeDirectory path})

-- | Export user functions to Haskell file
menuFileExportHaskell :: VPUI -> IO VPUI
menuFileExportHaskell vpui =
    chooseOutputFile "Export Haskell" vpui >>=
    maybeDefaultOptions defaultHaskellOptions >>=
    maybeExportUserFunctions vpui exportHaskell

-- | Export user functions to Python file
menuFileExportPython :: VPUI -> IO VPUI
menuFileExportPython vpui =
    chooseOutputFile "Export Python" vpui >>=
    maybeDefaultOptions defaultPythonOptions >>=
    maybeExportUserFunctions vpui (exportPython vpui)

-- | Export user functions to Scheme file
menuFileExportScheme :: VPUI -> IO VPUI
menuFileExportScheme vpui =
    chooseOutputFile "Export Scheme" vpui >>= 
    maybeRunSchemeOptionsDialog >>=
    -- maybeExportUserFunctions vpui (exportScheme defaultSchemeOptions) 
    maybeExportUserFunctions vpui (exportScheme vpui)

-- | Choose an output file, for file save, save as, and export commands
chooseOutputFile :: String -> VPUI -> IO (Maybe FilePath)
chooseOutputFile verb vpui = do
  chooser <- fileChooserDialogNew
               (Just (verb ++ " to file ...")) -- title
               Nothing          -- transient parent of the dialog
               FileChooserActionSave
               [(verb, ResponseOk), ("Cancel", ResponseCancel)] -- buttons
  _ <- fileChooserSetCurrentFolder chooser (vpuiCurrentDir vpui)
  result <- runDialogM (toDialog chooser) chooser fileChooserGetFilename
  return result

maybeDefaultOptions :: a -> Maybe FilePath -> IO (Maybe (FilePath, a))
maybeDefaultOptions defaultOptions mpath =
    case mpath of
      Nothing -> return Nothing
      Just path -> return $ Just (path, defaultOptions)

maybeRunSchemeOptionsDialog :: Maybe FilePath 
                            -> IO (Maybe (FilePath, SchemeOptions))
maybeRunSchemeOptionsDialog mpath =
    case mpath of
      Nothing -> return Nothing
      Just path ->
          let result :: Bool -> IO (Maybe (FilePath, SchemeOptions))
              result useLambda =
                  return (Just (path, 
                                SchemeOptions {defineWithLambda = useLambda}))
          in showChoicesDialog "Scheme Export Options"
                               "Use lambda in function definitions?"
                               ["Yes", "No"]
                               [result True, result False]
                               (result False)


-- | Save an image of a window in a file

menuFileSaveImage :: VPUI -> IO VPUI
menuFileSaveImage vpui = do
    mImageOptions <- chooseImageOptions vpui
    case mImageOptions of
      Nothing -> return vpui
      Just (windowId, fileExt) -> do
        mfile <- chooseOutputFile ("Save image of " ++ windowId) vpui
        case mfile of
          Nothing -> return vpui
          Just filePath ->
              saveImageFile vpui windowId filePath fileExt

-- | Returns (WinId, fileExtension),
-- e.g., ("Sifflet Workspace", ".svg"),
-- where fileExtension is ".svg", ".ps", or ".pdf"
chooseImageOptions :: VPUI -> IO (Maybe (WinId, String))
chooseImageOptions vpui =
    let hasCanvas winId = 
            isJust (vpuiWindowLookupCanvas (vpuiGetWindow vpui winId))
        -- We can only use Cairo to render a window that has a canvas
        windowChoices = filter hasCanvas (keys (vpuiWindows vpui))
        windowActions = map (return . Just) windowChoices
        formatChoices = ["SVG", "PS", "PDF"]
        formatActions = map (return . Just) [".svg", ".ps", ".pdf"]
    in do
      mExt <- showChoicesDialog "Save Image" "Select image format"
                                formatChoices formatActions (return Nothing)
      case mExt of
        Nothing -> return Nothing
        Just ext -> do
          mWinId <- 
            if length windowChoices == 1
            then return $ Just $ head windowChoices
            else showChoicesDialog "Save Image"
                            "Select window to save as image"
                            windowChoices windowActions (return Nothing)
          case mWinId of
            Nothing -> return Nothing
            Just winId -> return $ Just (winId, ext)

-- | Save the window image in the file format specified,
-- adding the right file extension to the file path if it is
-- not already present.
saveImageFile :: VPUI -> WinId -> FilePath -> String -> IO VPUI
saveImageFile vpui winId path ext =
    let vpuiWindow = vpuiGetWindow vpui winId
        canvas = vpuiWindowGetCanvas vpuiWindow 
        -- Size width height = vcSize canvas -- pixels (Double)
        clipbox@(BBox _ _ width height) = defaultFileSaveClipBox canvas
        -- cliprect = bbToRect clipbox

        render :: Surface -> IO ()
        render surface = 
            renderWith surface (renderCanvas canvas clipbox True)
                               -- (BBox 0 0  width height)
        path' = if takeExtension path == ext
                then path
                else addExtension path ext
        vpui' = vpui {vpuiCurrentDir = takeDirectory path}
    in case ext of
         ".pdf" -> withPDFSurface path' width height render >> return vpui'
         ".ps" -> withPSSurface path' width height render >> return vpui'
         ".svg" -> withSVGSurface path' width height render >> return vpui'
                   
         -- Cairo can do PNG too, but it is harder:
         --     surfaceWriteToPNG surface path'
         -- (have to get a surface and render to it first?)

         -- Anything else really should not happen, because
         -- chooseImageOptions returns one of the three extensions above.
         -- But just in case:
         _ -> do
           showErrorMessage $
              "Unable to save in this file format " ++
              "(" ++ ext ++ ").\n" ++
              "Please try a file extension of " ++
              ".svg, .ps, or .pdf."
           menuFileSaveImage vpui'



-- | Text shown by the help dialog
helpText :: String
helpText =
  unlines ["Functions menu:",
           "    \"New\" enters a dialog to create a new function.",
           "    \"Function pad\" raises the function pad window.",
           "Keystroke shortcuts for the menu commands are shown " ++
           "using \"C-\" for Control.  For example, Quit " ++
           "is C-q, meaning Control+Q.",
           "",
           "In a function editor, right-click for the context menu.",
           "",
           "For more help, please visit the Sifflet web site,",
           "http://mypage.iu.edu/~gdweber/software/sifflet/",
           "especially the Sifflet Tutorial:",
           "http://mypage.iu.edu/~gdweber/software/sifflet/doc/tutorial.html"
          ]

-- | Show the help dialog
showHelpDialog :: MenuItemAction
showHelpDialog vpui = showInfoMessage "Sifflet Help" helpText >> return vpui

-- | How to report bugs
bugsText :: String
bugsText =
    unlines ["To report bugs, please send mail to " ++ bugReportAddress,
             "and mention \"Sifflet\" in the Subject header.",
             "To send praise, follow the same procedure.",
             "Seriously, whether you like Sifflet or dislike it,",
             "I'd like to hear from you."
            ]

bugReportAddress :: String
bugReportAddress = concat ["gdweber", at, "iue", punctum, "edu"]
                   where at = "@"
                         punctum = "."

showBugs :: MenuItemAction
showBugs vpui = showInfoMessage "Reporting bugs" bugsText >> return vpui

-- | Text for the About dialog
aboutText :: String
aboutText =
    unlines ["Sifflet version " ++ showVersion Paths.version,
             "Copyright (C) 2010-2012 Gregory D. Weber",
             "",
             "BSD3 License",
             "",
             "Sifflet home page:",
             "http://mypage.iu.edu/~gdweber/software/sifflet/"
            ]

showAboutDialog :: MenuItemAction
showAboutDialog vpui = showInfoMessage "About Sifflet" aboutText >> return vpui

-- ----------------------------------------------------------------------

-- Moved here (WHY???) from Callbacks.hs:

setWSCanvasCallbacks :: VPUI -> WinId -> CBMgr -> IO ()
setWSCanvasCallbacks vpui winId cbmgr = do
  {
    let vw = vpuiGetWindow vpui winId
        window = vpuiWindowWindow vw
  ; case vpuiWindowLookupCanvas vw of
      Nothing ->
          errcats ["setWSCanvasCallbacks: VPUIWindow is not a VPUIWorkWin",
                   "and has no canvas"]
      Just canvas ->
          do
            {
            -- Notice when the window size is changed
            ; cbmgr (OnWindowConfigure window (configuredCallback winId))

            -- Keypress events -- send to canvas window because the Gtk.Layout
            -- cannot receive them (why ever not?)
            ; cbmgr (AfterWindowKeyPress window (keyPressCallback winId cbmgr))

            -- Send remaining events to the Gtk.Layout (why?)
            ; let layout = vcLayout canvas
            ; widgetSetCanFocus layout True
            ; cbmgr (OnLayoutExpose layout (exposedCallback winId))

            -- Mouse events 
            ; widgetAddEvents layout [PointerMotionMask]
            ; cbmgr (OnLayoutMouseMove layout (mouseMoveCallback winId))
            ; cbmgr (OnLayoutButtonPress layout 
                     (buttonPressCallback winId cbmgr))
            ; cbmgr (OnLayoutButtonRelease layout (buttonReleaseCallback winId))
            }
  }

-- | Context menu command to edit the function displayed in 
-- a CallFrame

editFrameFunction :: CBMgr -> CanvFrame -> VPUI -> IO VPUI
editFrameFunction cbmgr frame vpui =
    let func = cfFunctoid frame
    in showFedWin cbmgr (functoidName func) (functoidArgNames func) vpui

-- | Create a new function, add it to the global environment 
-- with body undefined, and start editing it in a new window.  
-- Also update and show "My Functions" toolbox and
-- update its toolkit.

editNewFunction :: CBMgr -> String -> [String] -> VPUI -> IO VPUI
editNewFunction cbmgr name args vpui = 
    let updateEnv :: VPUI -> IO VPUI
        updateEnv vpui' =
            let env = vpuiGlobalEnv vpui'
                env' = envIns env name (VFun (newUndefinedFunction name args))
            in return $ vpui' {vpuiGlobalEnv = env'}    
    in 
      -- Show window first, with the *old* functions
      showFunctionPadWindow cbmgr vpui >>=
      updateEnv >>=
      vpuiUpdateWindowIO functionPadWinId
                             (addFunctionPadToolButton cbmgr "My Functions" 
                              (functionTool name)) >>=
      showFedWin cbmgr name args

configuredCallback :: WinId -> IORef VPUI -> EventM EConfigure Bool
configuredCallback winId uiref =
    tryEvent $ do
      {
        (w, h) <- eventSize
      ; liftIO $ modifyIORef uiref (handleConfigured winId w h)
      -- We *must* "stop the event", forcing the event handler 
      -- to return False, or else the canvas remains "squeezed in"
      -- -- Weird!!
      ; stopEvent
      }

-- | Handle the Configured event.
handleConfigured :: WinId -> Int -> Int -> VPUI -> VPUI
handleConfigured winId width height vpui = 
    let vw = vpuiGetWindow vpui winId
        vw' = vpuiWindowModCanvas vw 
              (atLeastSize (Size (fromIntegral width) (fromIntegral height)))
    in vpuiReplaceWindow vpui winId vw'

exposedCallback :: WinId -> IORef VPUI -> EventM EExpose Bool
exposedCallback winId uiref =
    tryEvent $ do
      {
        cliprect <- eventArea
      ; liftIO (readIORef uiref >>= handleExposed winId cliprect)
      }

-- | Handle the Exposed event, should be called only for a window
-- with a canvas
handleExposed :: WinId -> Rectangle -> VPUI -> IO ()
handleExposed winId cliprect vpui = 
    let vw = vpuiGetWindow vpui winId -- error if not found
    in case vpuiWindowLookupCanvas vw of
         Nothing -> info "handleExposed: no canvas found!"
         Just canvas -> drawCanvas canvas cliprect 

data KeyBinding = KeyBinding {kbGtkKeyName :: String,
                              kbAltKeyName :: Maybe String, -- for humans
                              kbRequiredModifiers :: [Modifier],
                              kbDescription :: String,
                              kbAction :: KeyAction}

data KeyAction 
 = KeyActionST (WinId -> VPUI -> IO VPUI)          -- ^ set a tool
 | KeyActionDG (WinId -> CBMgr -> VPUI -> IO VPUI) -- ^ start a dialog
 | KeyActionModIO (CBMgr -> VPUI -> IO VPUI)       -- ^ modify VPUI with IO
 | KeyActionHQ (VPUI -> IO ())                     -- ^ help or quit

-- | Key bindings map.  This is derived from keyBindingsList.
keyBindingsMap :: Map Text KeyBinding
keyBindingsMap =
  Map.fromList [(pack (kbGtkKeyName kb), kb) | kb <- keyBindingsList]

-- | KeyBinding list for workspace and function editor windows.

keyBindingsList :: [KeyBinding]
keyBindingsList = 
    [
     -- Bindings to set tools
      KeyBinding "c" Nothing [] "connect" 
                     (KeyActionST (vpuiSetTool ToolConnect))
    , KeyBinding "d" Nothing [] "disconnect" 
                     (KeyActionST (vpuiSetTool ToolDisconnect))
    , KeyBinding "i" Nothing [] "if" (KeyActionST (vpuiSetTool ToolIf))
    , KeyBinding "m" Nothing [] "move" (KeyActionST (vpuiSetTool ToolMove))
    , KeyBinding "KP_Delete" (Just "Keypad-Del") [] "delete" 
                             (KeyActionST (vpuiSetTool ToolDelete))

    -- Bindings to start dialogs
    , KeyBinding "n" Nothing [] "new function" (KeyActionDG newFunctionDialog)
    , KeyBinding "f" Nothing [] "function" (KeyActionDG showFunctionEntry)
    , KeyBinding "l" Nothing [] "literal" (KeyActionDG showLiteralEntry)

     -- Help and quit

    , KeyBinding "question" (Just "?") [] "help" (KeyActionHQ vpuiKeyHelp)

     -- Shortcuts for menu commands (GTK "accelerators", but not done
     -- in the standard GTK way).
     -- These need to be coordinated with buildMainMenu,
     -- in WindowManagement.hs

-- Oops!  Binding Ctrl+F here interferes with binding just plain f above.
--    , KeyBinding "f" (Just "Control-f") [Control] "function-pad"
--                     (KeyActionModIO showFunctionPadWindow)

    , KeyBinding "o" (Just "Control-o") [Control] "open"
                     (KeyActionModIO menuFileOpen)
    , KeyBinding "s" (Just "Control-s") [Control] "save"
                     (KeyActionModIO (\ _cbmgr -> menuFileSave))
    , KeyBinding "q" (Just "Control-q") [Control] "quit" 
                     (KeyActionHQ (\ vpui -> menuFileQuit vpui >> return ()))
    ]

-- | Unused argument needed for key bindings
vpuiKeyHelp :: VPUI -> IO ()
vpuiKeyHelp _vpui = putStrLn keyBindingsHelpText

-- | Help text built from key bindings
keyBindingsHelpText :: String
keyBindingsHelpText = 
    let add :: String -> KeyBinding -> String
        add result (kb@KeyBinding {kbAltKeyName = mkey}) =
            concat [result, " ", 
                    case mkey of 
                      Nothing -> kbGtkKeyName kb
                      Just akey -> akey, 
                    " = ", kbDescription kb, "\n"]
    in foldl add "" keyBindingsList

-- | What to do when a key is pressed
keyPressCallback :: WinId -> CBMgr -> IORef VPUI -> EventM EKey Bool
keyPressCallback winId cbmgr uiref =
    tryEvent $ do
      {
        kname <- eventKeyName
      ; mods <- eventModifier
      -- ; liftIO $ print mods

      ; let giveUp = 
                -- liftIO (info ("Unrecognized key: " ++ kname)) >> 
                stopEvent

      ; case Map.lookup kname keyBindingsMap of
          Nothing -> 
              giveUp
          Just keyBinding -> 
              if checkMods (kbRequiredModifiers keyBinding) mods
              then liftIO $ 
                     case kbAction keyBinding of
                       KeyActionModIO f0 ->
                           -- update with IO
                           modifyIORefIO (f0 cbmgr) uiref
                       KeyActionST f1 ->
                           -- update with IO and window ID
                           modifyIORefIO (f1 winId) uiref
                       KeyActionDG f2 ->
                           -- update with IO and cbmgr to set further callbacks
                           modifyIORefIO (f2 winId cbmgr) uiref
                       KeyActionHQ f3 ->
                           -- no update, no cbmgr, no further callbacks
                           readIORef uiref >>= f3
              else giveUp
      }

buttonPressCallback :: WinId -> CBMgr -> IORef VPUI -> EventM EButton Bool
buttonPressCallback winId cbmgr uiref =
    tryEvent $ do
      {
      ; (x, y) <- eventCoordinates
      ; mouseButton <- eventButton
      ; mods <- eventModifier
      ; timestamp <- eventTime
      ; let updateAction = 
                handleButtonPress winId cbmgr mouseButton x y mods timestamp
      ; liftIO (modifyIORefIO updateAction uiref)
      }

mouseMoveCallback :: WinId -> IORef VPUI -> EventM EMotion Bool
mouseMoveCallback winId uiref =
    tryEvent $ do
      {
        (x, y) <- eventCoordinates
      ; mods <- eventModifier
      ; liftIO (modifyIORefIO (handleMouseMove winId x y mods) uiref)
      }

buttonReleaseCallback :: WinId -> IORef VPUI -> EventM EButton Bool
buttonReleaseCallback winId uiref =
    tryEvent $ do
      {
        mouseButton <- eventButton
      ; liftIO (modifyIORefIO (handleButtonRelease winId mouseButton) uiref)
      }

-- | Handle the ButtonPress event.  Should be called only for a window
-- with a canvas.
handleButtonPress :: WinId -> CBMgr -> MouseButton 
                  -> Double -> Double -- x, y
                  -> [Modifier] -> TimeStamp -- timestamp not needed?
                  -> VPUI ->IO VPUI
handleButtonPress winId cbmgr mouseButton x y mods timestamp vpui  =
    let vw = vpuiGetWindow vpui winId
    in case vpuiWindowLookupCanvas vw of
         Nothing -> info "handleButtonPress: no canvas found!" >>
                    return vpui
         Just canvas ->
             case whichFrame canvas x y of
               Nothing ->
                   case vcTool canvas of
                     Nothing -> return vpui
                     Just tool -> toolOp tool vpui winId TCWorkspace mods x y 
               Just frame -> 
                   frameButtonPressed winId cbmgr vw
                                      frame mods (x, y)
                                      mouseButton timestamp vpui

-- | Handles button pressed in a frame
frameButtonPressed :: WinId -> CBMgr -> VPUIWindow -> CanvFrame 
                   -> [Modifier] -> (Double, Double) -> MouseButton 
                   -> TimeStamp 
                   -> VPUI
                   -> IO VPUI
frameButtonPressed winId cbmgr vw frame mods (x, y) mouseButton timestamp vpui =
    let retWrap :: VPUIWindow -> IO VPUI
        retWrap = return . vpuiReplaceWindow vpui winId
    in case mouseButton of
        LeftButton ->
            if  cfPointInHeader frame x y 
            then beginFrameDrag vw frame x y >>= retWrap
            else if cfPointInFooter frame x y
                 then leftButtonPressedInFrameFooter vw frame >>= retWrap
                 else frameBodyButtonPressed vpui winId frame 
                                             mouseButton mods x y
        MiddleButton -> return vpui
        RightButton -> do
          offerContextMenu winId cbmgr frame RightButton timestamp 
                           (vpuiDebugging vpui)
          return vpui
        OtherButton _ -> return vpui

-- | Handles button pressed in the body of a frame
-- frameBodyButtonPressed needs VPUIWindow because it calls a toolOp.
-- mb (mouse button) is unused, but might be used later.
frameBodyButtonPressed :: VPUI -> WinId -> CanvFrame 
                         -> MouseButton -> [Modifier] -> Double -> Double 
                         -> IO VPUI
frameBodyButtonPressed vpui winId frame _mb mods x y = do
  {
    let vw = vpuiGetWindow vpui winId
        canvas = vpuiWindowGetCanvas vw
        mnode = vcanvasNodeAt canvas (Position x y)
  ; case mnode of
      Nothing -> 
          case vcTool canvas of
            Nothing -> return vpui
            Just tool -> toolOp tool vpui winId (cfContext frame) mods x y
      Just node -> 
          do
            {
              vw' <- openNode vw node
            ; return $ vpuiReplaceWindow vpui winId vw'
            }
  }

-- | Handles left button pressed in the footer of a frame
leftButtonPressedInFrameFooter ::
    VPUIWindow -> CanvFrame -> IO VPUIWindow
leftButtonPressedInFrameFooter vw frame = 
    let canvas = vpuiWindowGetCanvas vw
    in case frameType frame of
         CallFrame -> 
             -- request argument values and evaluate call
             if cfEvalReady frame
             then do
               canvas' <- vcEvalDialog canvas frame
               return $ vpuiWindowSetCanvas vw canvas'
             else return vw
         EditFrame ->
             -- ignore
             return vw

-- | Handles beginning of mouse-drag
beginFrameDrag :: VPUIWindow  -> CanvFrame -> Double -> Double 
               -> IO VPUIWindow
beginFrameDrag vw frame x y = 
    let canvas = vpuiWindowGetCanvas vw
        window = vpuiWindowWindow vw
        dragging = Dragging {draggingNode = cfFrameNode frame,
                             draggingPosition = Position x y}
        canvas' = canvas {vcDragging = Just dragging}
    in setCursor window Fleur >> 
       (return $ vpuiWindowSetCanvas vw canvas')

-- | Handle mouse move event
handleMouseMove :: WinId -> Double -> Double -> [Modifier] -> VPUI -> IO VPUI
handleMouseMove winId x y mods vpui =
-- Needs to be in IO because of drawWindowInvalidateRect
    let vw = vpuiGetWindow vpui winId
    in case vpuiWindowLookupCanvas vw of
         Nothing -> 
             info "SQUAWK!  No canvas!  Shouldn't happen!" >>
             return vpui -- shouldn't happen
         Just canvas -> 
             do
               {
                 -- Highlight the active node, if any
                 let active = vcActive canvas
                     active' = vcanvasNodeAt canvas (Position x y)

                     invalidate :: DrawWindow -> Maybe G.Node -> IO ()
                     invalidate win mnode =
                         case mnode of
                           Nothing -> return ()
                           Just node -> 
                               drawWindowInvalidateRect win 
                                    (vcanvasNodeRect canvas node) False

               ; when (active /= active') $
                 do
                   {
                     win <- layoutGetDrawWindow (vcLayout canvas)
                   ; invalidate win active
                   ; invalidate win active'
                   }
               -- if dragging, continue drag
               ; canvas' <- continueDrag (canvas {vcActive = active', 
                                                  vcMousePos = (x, y)}) 
                            mods x y
               ; let vw' = vpuiWindowSetCanvas vw canvas'
               ; return $ vpuiReplaceWindow vpui winId vw'
               }

continueDrag :: VCanvas -> [Modifier] -> Double -> Double -> IO VCanvas
continueDrag canvas mods x y =
  case vcDragging canvas of
    Nothing -> return canvas
    Just dragging -> 
        let graph = vcGraph canvas
            dnode = draggingNode dragging
            wnode = wlab graph dnode
            Position oldX oldY = draggingPosition dragging
            (dx, dy) = (x - oldX, y - oldY)
        in
          case wnode of
             WSimple _ -> 
                 continueDragSimple canvas dragging dnode mods x y dx dy 
             WFrame frameNode -> 
                 continueDragFrame canvas dragging frameNode x y dx dy 

continueDragSimple :: VCanvas -> Dragging -> G.Node -> [Modifier] 
                   -> Double -> Double -> Double -> Double -> IO VCanvas
continueDragSimple canvas dragging simpleNode mods x y dx dy =
    let graph = vcGraph canvas
        frame = nodeContainerFrame canvas graph simpleNode
        dragging' = dragging {draggingPosition = Position x y}
        translateSelection = if checkMods [Shift] mods
                             then translateTree
                             else translateNode
        graph' = translateSelection dx dy graph simpleNode
        canvas' = canvas {vcGraph = graph'}
    in vcInvalidateFrameWithParent canvas graph frame >>
       return (canvas' {vcDragging = Just dragging'})

continueDragFrame :: 
    VCanvas -> Dragging -> G.Node -> 
    Double -> Double -> Double -> Double -> IO VCanvas
continueDragFrame canvas dragging frameNode x y dx dy =
  let graph = vcGraph canvas
      frame = vcGetFrame canvas graph frameNode
      frame' = translateFrame frame dx dy
      graph' = grTranslateFrameNodes graph frame dx dy
      canvas' = vcUpdateFrameAndGraph canvas frame' graph'
      dragging' = Just dragging {draggingPosition = Position x y}
  in 
    -- Tell the GUI about the changes so they will be redrawn
    -- Mark the frame changed so it will be redrawn
    frameChanged canvas graph frame graph' frame' >>
    -- Also, any frames opened from nodes of this frame
    mapM_ (\f -> frameChanged canvas graph f graph' f)
          (vcFrameSubframes canvas frame) >>
    -- Return the modified canvas
    return (canvas' {vcDragging = dragging'})

handleButtonRelease :: WinId -> MouseButton -> VPUI -> IO VPUI
handleButtonRelease winId mouseButton vpui =
    case mouseButton of
      LeftButton -> 
          -- End drag
          let vw = vpuiGetWindow vpui winId
              canvas = vpuiWindowGetCanvas vw
              window = vpuiWindowWindow vw
              vw' = vpuiWindowSetCanvas vw (canvas {vcDragging = Nothing})
              vpui' = vpuiReplaceWindow vpui winId vw'
          in setCursor window LeftPtr >>
             return vpui'
      _ -> return vpui

-- | Show a context menu for mouse click in a frame.
offerContextMenu :: WinId -> CBMgr -> CanvFrame 
                 -> MouseButton -> TimeStamp -> Bool -> IO ()
offerContextMenu winId cbmgr frame button timestamp debugging = do
  -- Needs CBMgr to specify menu actions.
  {
    let menuSpec = 
            MenuSpec "Context Menu" 
                     (contextMenuOptions winId cbmgr frame debugging)
  ; menu <- createMenu menuSpec cbmgr
  ; widgetShowAll menu
  ; menuPopup menu (Just (button, timestamp))
  }

-- | Options for context menu that depend on the frame type.

contextMenuOptions :: WinId -> CBMgr -> CanvFrame -> Bool -> [MenuItemSpec]
contextMenuOptions winId cbmgr frame debugging =
    let typeDependentOptions :: [MenuItemSpec]
        typeDependentOptions =
            case frameType frame of
              CallFrame -> 
                  [MenuItem "Edit" (editFrameFunction cbmgr frame)
                  , MenuItem "Close" (\ vpui -> closeFrame vpui winId frame)]
              EditFrame -> 
                  [
                  -- The next items duplicate parts of keyBindingsList
                    MenuItem "CONNECT (c)" (vpuiSetTool ToolConnect winId)
                  , MenuItem "DISCONNECT (d)" (vpuiSetTool ToolDisconnect winId)
                  , MenuItem "IF (i)" (vpuiSetTool ToolIf winId)
                  , MenuItem "FUNCTION (f)" (showFunctionEntry winId cbmgr)
                  , MenuItem "LITERAL (l)" (showLiteralEntry winId cbmgr)
                  -- , ("CLEAR (not implemented)", clearFrame winId frame)
                  , MenuItem "MOVE (m)" (vpuiSetTool ToolMove winId)
                  , MenuItem "DELETE (KP-Del)" (vpuiSetTool ToolDelete winId)
                  ]
    in typeDependentOptions ++
       if debugging
          then [MenuItem "Dump frame (debug)"
                         (\ vpui -> dumpFrame vpui winId frame >> return vpui)
               , MenuItem "Dump graph (debug)"
                          (\ vpui -> dumpGraph vpui winId >> return vpui)
               ]
          else []