[htoolkit-cvs] gio/src/Graphics/UI GIO.hs,1.6,1.7

[<kr_...@us...>]

Update of /cvsroot/htoolkit/gio/src/Graphics/UI
In directory sc8-pr-cvs1:/tmp/cvs-serv28204a/src/Graphics/UI

Modified Files:
	GIO.hs 
Log Message:
Added support for ProcessDismiss and ProcessDestroy events


Index: GIO.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO.hs,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** GIO.hs	25 Mar 2003 23:27:40 -0000	1.6
--- GIO.hs	26 Mar 2003 08:54:55 -0000	1.7
***************
*** 1,2 ****
--- 1,3 ----
+ {-# OPTIONS -fglasgow-exts #-}
  -----------------------------------------------------------------------------------------
  {-| Module      :  GIO
***************
*** 45,54 ****
  import Graphics.UI.GIO.Controls
  
  -- | Start the event loop. 'quit' is automatically called all windows are closed.
! start :: String -> DocumentInterface -> IO a -> IO ()
! start title di io
    = do curdir <- getCurrentDirectory
!        Lib.start title di io `catch` \err -> do{ quit; ioError err }
         setCurrentDirectory curdir
  
  -- | Force the event loop to terminate.
--- 46,65 ----
  import Graphics.UI.GIO.Controls
  
+ data Process
+ 
+ instance Deadly Process where
+   dismiss   = newEvent (const Lib.getProcessDismissHandler) (const Lib.setProcessDismissHandler) (const Lib.setProcessDismissDefHandler)
+   destroy   = newEvent (const Lib.getProcessDestroyHandler) (const Lib.setProcessDestroyHandler) (const Lib.setProcessDestroyDefHandler)
+ 
  -- | Start the event loop. 'quit' is automatically called all windows are closed.
! start :: String -> DocumentInterface -> [Prop Process] -> IO a -> IO ()
! start title di props io
    = do curdir <- getCurrentDirectory
!        Lib.start title di action
         setCurrentDirectory curdir
+        where
+           action = do
+              mapM_ (set1 undefined) props
+              io `catch` \err -> do{ quit; ioError err }
  
  -- | Force the event loop to terminate.