htoolkit-cvs — HToolkit CVS commit messages

[htoolkit-cvs] port/src/cbits/Win32 Menu.c,1.3,1.4

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

Update of /cvsroot/htoolkit/port/src/cbits/Win32
In directory sc8-pr-cvs1:/tmp/cvs-serv30647/port/src/cbits/Win32

Modified Files:
	Menu.c 
Log Message:
Additional functions for menu item state


Index: Menu.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/Win32/Menu.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Menu.c	30 Jan 2003 23:09:47 -0000	1.3
--- Menu.c	26 Mar 2003 12:59:24 -0000	1.4
***************
*** 124,136 ****
  }
  
! void osSetMenuItemSelectState(MenuHandle parent, MenuHandle item, BOOL bState)
  {
  	EnableMenuItem(parent, (UINT) item, (bState ? MF_ENABLED : MF_GRAYED) | MF_BYCOMMAND);
  };
  
! void osSetCheckMenuItemState(MenuHandle parent, MenuHandle item, BOOL bState)
  {
  	CheckMenuItem(parent, (UINT) item, (bState ? MF_CHECKED : MF_UNCHECKED) | MF_BYCOMMAND);
  };
  
  void osSetMenuItemLabel(MenuHandle parent, MenuHandle item, int key, unsigned int mods, char* title)
--- 124,154 ----
  }
  
! void osSetMenuItemEnabled(MenuHandle parent, MenuHandle item, BOOL bState)
  {
  	EnableMenuItem(parent, (UINT) item, (bState ? MF_ENABLED : MF_GRAYED) | MF_BYCOMMAND);
  };
  
! BOOL osGetMenuItemEnabled(MenuHandle parent, MenuHandle item)
! {
! 	MENUITEMINFO mii;
! 	mii.cbSize = sizeof(mii);
! 	mii.fMask = MIIM_STATE;
! 	GetMenuItemInfo(parent, item, FALSE, &mii);
! 	return (mii.fState & MFS_ENABLED) != 0;
! };
! 
! void osSetMenuItemChecked(MenuHandle parent, MenuHandle item, BOOL bState)
  {
  	CheckMenuItem(parent, (UINT) item, (bState ? MF_CHECKED : MF_UNCHECKED) | MF_BYCOMMAND);
  };
+ 
+ BOOL osGetMenuItemChecked(MenuHandle parent, MenuHandle item)
+ {
+ 	MENUITEMINFO mii;
+ 	mii.cbSize = sizeof(mii);
+ 	mii.fMask = MIIM_STATE;
+ 	GetMenuItemInfo(parent, item, FALSE, &mii);
+ 	return (mii.fState & MFS_CHECKED) != 0;
+ }
  
  void osSetMenuItemLabel(MenuHandle parent, MenuHandle item, int key, unsigned int mods, char* title)

[htoolkit-cvs] port/src/cbits/GTK Menu.c,1.3,1.4

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

Update of /cvsroot/htoolkit/port/src/cbits/GTK
In directory sc8-pr-cvs1:/tmp/cvs-serv30647/port/src/cbits/GTK

Modified Files:
	Menu.c 
Log Message:
Additional functions for menu item state


Index: Menu.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/GTK/Menu.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Menu.c	30 Jan 2003 23:09:46 -0000	1.3
--- Menu.c	26 Mar 2003 12:59:24 -0000	1.4
***************
*** 75,88 ****
  }
  
! void osSetMenuItemSelectState(MenuHandle parent, MenuHandle item, BOOL bState)
  {
  	gtk_widget_set_sensitive(item,bState);
  };
  
! void osSetCheckMenuItemState(MenuHandle parent, MenuHandle item, BOOL bState)
  {
  	in_handler_flag++;
  	gtk_check_menu_item_set_active  (GTK_CHECK_MENU_ITEM(item), bState);
  	in_handler_flag--;
  };
  
--- 75,98 ----
  }
  
! void osSetMenuItemEnabled(MenuHandle parent, MenuHandle item, BOOL bState)
  {
  	gtk_widget_set_sensitive(item,bState);
  };
  
! BOOL osGetMenuItemEnabled(MenuHandle parent, MenuHandle item)
! {
! 	return GTK_WIDGET_SENSITIVE(item);
! };
! 
! void osSetMenuItemChecked(MenuHandle parent, MenuHandle item, BOOL bState)
  {
  	in_handler_flag++;
  	gtk_check_menu_item_set_active  (GTK_CHECK_MENU_ITEM(item), bState);
  	in_handler_flag--;
+ };
+ 
+ BOOL osGetMenuItemChecked(MenuHandle parent, MenuHandle item)
+ {
+ 	return gtk_check_menu_item_get_active(GTK_CHECK_MENU_ITEM(item));
  };
  

[htoolkit-cvs] port/src/include Menu.h,1.3,1.4

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

Update of /cvsroot/htoolkit/port/src/include
In directory sc8-pr-cvs1:/tmp/cvs-serv30647/port/src/include

Modified Files:
	Menu.h 
Log Message:
Additional functions for menu item state


Index: Menu.h
===================================================================
RCS file: /cvsroot/htoolkit/port/src/include/Menu.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Menu.h	30 Jan 2003 23:09:47 -0000	1.3
--- Menu.h	26 Mar 2003 12:59:24 -0000	1.4
***************
*** 10,16 ****
  void osAddMenuSeparatorItem(MenuHandle parent);
  
! void osSetMenuItemSelectState(MenuHandle parent, MenuHandle item, BOOL bState);
! void osSetCheckMenuItemState(MenuHandle parent, MenuHandle item, BOOL bState);
! void osSetRadioMenuItemState(MenuHandle parent, MenuHandle item, BOOL bState);
  
  void osSetMenuItemLabel(MenuHandle menu, MenuHandle item, int nKeyCode, unsigned int mods, char* title);
--- 10,17 ----
  void osAddMenuSeparatorItem(MenuHandle parent);
  
! void osSetMenuItemEnabled(MenuHandle parent, MenuHandle item, BOOL bState);
! BOOL osGetMenuItemEnabled(MenuHandle parent, MenuHandle item);
! void osSetMenuItemChecked(MenuHandle parent, MenuHandle item, BOOL bState);
! BOOL osGetMenuItemChecked(MenuHandle parent, MenuHandle item);
  
  void osSetMenuItemLabel(MenuHandle menu, MenuHandle item, int nKeyCode, unsigned int mods, char* title);

[htoolkit-cvs] port/src/include Types.h,1.6,1.7

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

Update of /cvsroot/htoolkit/port/src/include
In directory sc8-pr-cvs1:/tmp/cvs-serv29420/port/src/include

Modified Files:
	Types.h 
Log Message:
bugfixes


Index: Types.h
===================================================================
RCS file: /cvsroot/htoolkit/port/src/include/Types.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** Types.h	26 Mar 2003 02:19:57 -0000	1.6
--- Types.h	26 Mar 2003 12:56:30 -0000	1.7
***************
*** 72,76 ****
  	guint id;
  	int interval;
! 	BOOL enabled;
  } *TimerHandle;
  
--- 72,76 ----
  	guint id;
  	int interval;
! 	gboolean enabled;
  } *TimerHandle;
  

[htoolkit-cvs] port/src/cbits/GTK Timer.c,1.4,1.5

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

Update of /cvsroot/htoolkit/port/src/cbits/GTK
In directory sc8-pr-cvs1:/tmp/cvs-serv29420/port/src/cbits/GTK

Modified Files:
	Timer.c 
Log Message:
bugfixes


Index: Timer.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/GTK/Timer.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** Timer.c	26 Mar 2003 02:19:57 -0000	1.4
--- Timer.c	26 Mar 2003 12:56:30 -0000	1.5
***************
*** 1,71 ****
! #include "Timer.h"
! #include "Handlers_stub.h"
! #include "Internals.h"
! 
! static gboolean osTimerProc(gpointer data)
! {
!   handleTimer((TimerHandle) data);
!   return TRUE;
! }
! 
! TimerHandle osCreateTimer(int msecs)
! {
! 	TimerHandle timer = rmalloc(sizeof(*timer));
! 	timer->interval = msecs;
! 	timer->enabled  = TRUE;
! 	timer->id = (msecs > 0) ? gtk_timeout_add(msecs, osTimerProc, timer) : 0;
! 
! 	gActiveObjects++;
! 	return timer;
! }
! 
! void osDestroyTimer(TimerHandle timer)
! {
! 	if (timer!=NULL)
! 	{
! 		if (timer->id > 0)
! 			gtk_timeout_remove(timer->id);
! 		rfree(timer);
! 		gActiveObjects--;
! 	}
! }
! 
! void osSetTimerInterval(TimerHandle timer, int msecs)
! {
! 	if (timer->interval != msecs)
! 	{
! 		timer->interval = msecs;
! 		if (timer->enabled)
! 		{
! 			if (timer->id > 0)
! 				gtk_timeout_remove(timer->id);
! 			timer->id = (msecs > 0) gtk_timeout_add(msecs, osTimerProc, timer) : 0;
! 		}
! 	}
! };
! 
! int osGetTimerInterval(TimerHandle timer)
! {
! 	return timer->interval;
! };
! 
! void osEnableTimer(TimerHandle timer, BOOL enabled)
! {
! 	timer->enabled = enabled;
! 	if (timer->enabled)
! 	{
! 		if (timer->id <= 0 && timer->interval > 0)
! 			timer->id = gtk_timeout_add(msecs, osTimerProc, timer);
! 	}
! 	else
! 	{
! 		if (timer->id > 0)
! 		  gtk_timeout_remove(timer->id);
! 		timer->id = 0;
! 	}
! };
! 
! BOOL osIsTimerEnabled(TimerHandle timer)
! {
! 	return timer->enabled;
! };
--- 1,71 ----
! #include "Timer.h"
! #include "Handlers_stub.h"
! #include "Internals.h"
! 
! static gboolean osTimerProc(gpointer data)
! {
!   handleTimer((TimerHandle) data);
!   return TRUE;
! }
! 
! TimerHandle osCreateTimer(int msecs)
! {
! 	TimerHandle timer = rmalloc(sizeof(*timer));
! 	timer->interval = msecs;
! 	timer->enabled  = TRUE;
! 	timer->id = (msecs > 0) ? gtk_timeout_add(msecs, osTimerProc, timer) : 0;
! 
! 	gActiveObjects++;
! 	return timer;
! }
! 
! void osDestroyTimer(TimerHandle timer)
! {
! 	if (timer!=NULL)
! 	{
! 		if (timer->id > 0)
! 			gtk_timeout_remove(timer->id);
! 		rfree(timer);
! 		gActiveObjects--;
! 	}
! }
! 
! void osSetTimerInterval(TimerHandle timer, int msecs)
! {
! 	if (timer->interval != msecs)
! 	{
! 		timer->interval = msecs;
! 		if (timer->enabled)
! 		{
! 			if (timer->id > 0)
! 				gtk_timeout_remove(timer->id);
! 			timer->id = (msecs > 0) ? gtk_timeout_add(msecs, osTimerProc, timer) : 0;
! 		}
! 	}
! };
! 
! int osGetTimerInterval(TimerHandle timer)
! {
! 	return timer->interval;
! };
! 
! void osEnableTimer(TimerHandle timer, BOOL enabled)
! {
! 	timer->enabled = enabled;
! 	if (timer->enabled)
! 	{
! 		if (timer->id <= 0 && timer->interval > 0)
! 			timer->id = gtk_timeout_add(timer->interval, osTimerProc, timer);
! 	}
! 	else
! 	{
! 		if (timer->id > 0)
! 		  gtk_timeout_remove(timer->id);
! 		timer->id = 0;
! 	}
! };
! 
! BOOL osIsTimerEnabled(TimerHandle timer)
! {
! 	return timer->enabled;
! };

[htoolkit-cvs] gio configure,1.1.1.1,1.2

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

Update of /cvsroot/htoolkit/gio
In directory sc8-pr-cvs1:/tmp/cvs-serv29420/gio

Modified Files:
	configure 
Log Message:
bugfixes


Index: configure
===================================================================
RCS file: /cvsroot/htoolkit/gio/configure,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -d -r1.1.1.1 -r1.2
*** configure	26 Jan 2003 12:41:36 -0000	1.1.1.1
--- configure	26 Mar 2003 12:56:30 -0000	1.2
***************
*** 65,71 ****
  # just for windows: ghc-pkg doesn't like /home
  case "$curdir" in
!   /home*)  if test -z "$HOMEDRIVE"; then
! 	     # nothing
! 	   else
  	     curdir="`echo $curdir | sed -e 's|/home||'`"
  	     curdir="$HOMEDRIVE$curdir"
--- 65,69 ----
  # just for windows: ghc-pkg doesn't like /home
  case "$curdir" in
!   /home*)  if test ! -z "$HOMEDRIVE"; then
  	     curdir="`echo $curdir | sed -e 's|/home||'`"
  	     curdir="$HOMEDRIVE$curdir"
***************
*** 155,161 ****
    # just for windows: haddock doesn't like /home
    case "$hdocdir" in
!     /home*)  if test -z "$HOMEDRIVE"; then
!                # nothing
! 	     else
  	       hdocdir="`echo $hdocdir | sed -e 's|/home||'`"
  	       hdocdir="$HOMEDRIVE$hdocdir"
--- 153,157 ----
    # just for windows: haddock doesn't like /home
    case "$hdocdir" in
!     /home*)  if test ! -z "$HOMEDRIVE"; then
  	       hdocdir="`echo $hdocdir | sed -e 's|/home||'`"
  	       hdocdir="$HOMEDRIVE$hdocdir"
***************
*** 237,253 ****
  echo ""			>> config/config.mk
  echo "HDOC=$hdoc"        >> config/config.mk
! if test -z "$hdochtml"; then
!  # nothing
! else
   echo "HDOCHTML=$hdochtml" >> config/config.mk
  fi
! if test -z "$hdoclibs"; then
!  # nothing
! else
   echo "HDOCBASE=$hdoclibs/base.haddock" >> config/config.mk
  fi
! if test -z "$portdir"; then
!  # nothing
! else
   echo "PORTDIR=$portdir"  >> config/config.mk
  fi
--- 233,243 ----
  echo ""			>> config/config.mk
  echo "HDOC=$hdoc"        >> config/config.mk
! if test ! -z "$hdochtml"; then
   echo "HDOCHTML=$hdochtml" >> config/config.mk
  fi
! if test ! -z "$hdoclibs"; then
   echo "HDOCBASE=$hdoclibs/base.haddock" >> config/config.mk
  fi
! if test ! -z "$portdir"; then
   echo "PORTDIR=$portdir"  >> config/config.mk
  fi
***************
*** 274,276 ****
  
  echo "done -- type 'make' to build the 'gio' package."
! echo ""
\ No newline at end of file
--- 264,266 ----
  
  echo "done -- type 'make' to build the 'gio' package."
! echo ""

[htoolkit-cvs] gio/src/Graphics/UI/GIO CommonDialogs.hs,NONE,1.1 Messages.hs,NONE,1.1 FileDialog.hs,1.1.1.1,NONE

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

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

Added Files:
	CommonDialogs.hs Messages.hs 
Removed Files:
	FileDialog.hs 
Log Message:
FileDialog module is renamed to CommonDialogs. The CommonDialog exports all file related dialogs and dialogs for Font and Color selection. The Messages module exports all message alerts


--- NEW FILE: CommonDialogs.hs ---
-----------------------------------------------------------------------------------------
{-| Module      :  CommonDialogs
    Copyright   :  (c) Krasimir Angelov 2003
    License     :  BSD-style

    Maintainer  :  ka2...@ya...
    Stability   :  provisional
    Portability :  portable

    Common dialogs.
-}
-----------------------------------------------------------------------------------------
module Graphics.UI.GIO.CommonDialogs
            ( runDirectoryDialog
            , runInputFileDialog
            , runOutputFileDialog
            , runFontDialog
            , runColorDialog
            ) where


import Graphics.UI.GIO.Types
import qualified Graphics.UI.Port as Lib

{--------------------------------------------------------------------
  Just simple wrappers
--------------------------------------------------------------------}
-- | Run a dialog to select an input file. Returns 'Nothing' when cancelled.
runInputFileDialog :: IO (Maybe String)
runInputFileDialog = Lib.runInputFileDialog

-- | Run a dialog to select an output file. Takes both a prompt message and a 
-- suggested filename as arguments. Returns 'Nothing' when cancelled.
runOutputFileDialog :: String -> String -> IO (Maybe String)
runOutputFileDialog = Lib.runOutputFileDialog

-- | Runs a dialog to select a directory. Returns 'Nothing' when cancelled.
runDirectoryDialog :: IO (Maybe String)
runDirectoryDialog = Lib.runDirectoryDialog
  
-- | Run a dialog to select a font. Returns 'Nothing' when cancelled.
runFontDialog :: IO (Maybe FontDef)
runFontDialog = Lib.runFontDialog

-- | Run a dialog to select a color. Returns 'Nothing' when cancelled.
runColorDialog :: IO (Maybe Color)
runColorDialog = Lib.runColorDialog
--- NEW FILE: Messages.hs ---
-----------------------------------------------------------------------------------------
{-| Module      :  Messages
    Copyright   :  (c) Krasimir Angelov 2003
    License     :  BSD-style

    Maintainer  :  ka2...@ya...
    Stability   :  provisional
    Portability :  portable

    The message functions create, display, and operate a message box. The
    message box contains an application-defined message and any combination
    of predefined icons and push buttons.
-}
-----------------------------------------------------------------------------------------

module Graphics.UI.GIO.Messages
			( messageAlert
			, messageConfirm
			, messageWarning
			, messageQuestion
			, messageError
			, QuestionAnswer(..)
			, messageCancelQuestion
			, messageConfirmSave 
			) where

import Graphics.UI.Port (QuestionAnswer(..))
import qualified Graphics.UI.Port as Lib

-- | The messageAlert box provides an OK button and an image which indicates that
-- the given message is just for information.
messageAlert :: String -> IO ()
messageAlert = Lib.messageAlert

-- | The messageConfirm box, like the 'messageAlert' box provides an OK button, and in addition 
-- a Cancel button. An image indicates that the given message is just for information. 
-- The function returns True when the box is closed with the OK button; in all other cases it returns False.
messageConfirm :: String -> IO Bool
messageConfirm = Lib.messageConfirm

-- | The messageWarning box provides an OK button and an image which indicates that
-- the given message is a warning.
messageWarning :: String -> IO ()
messageWarning = Lib.messageWarning

-- | The messageQuestion box provides Yes and No buttons and an image which indicates that
-- the given message is a question. The function returns True for Yes button and False for No answer.
messageQuestion :: String -> IO Bool
messageQuestion = Lib.messageQuestion

-- | The messageError box provides OK and Cancel buttons and an image which indicates that
-- it is an error message. The function returns True when the box is closed
-- with the OK button; in all other cases it returns False.
messageError :: String -> IO Bool
messageError = Lib.messageError

-- | The messageCancelQuestion box like the 'messageQuestion' box provides an Yes and No buttons,and in addition 
-- a Cancel button. An image indicates that the given message is a question. 
messageCancelQuestion :: String -> IO QuestionAnswer
messageCancelQuestion = Lib.messageCancelQuestion

-- | The messageConfirmSave box is applicable when the application asks whether the document should be saved or not.
messageConfirmSave :: String -> IO QuestionAnswer
messageConfirmSave = Lib.messageConfirmSave

--- FileDialog.hs DELETED ---

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

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

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

Modified Files:
	GIO.hs 
Log Message:
FileDialog module is renamed to CommonDialogs. The CommonDialog exports all file related dialogs and dialogs for Font and Color selection. The Messages module exports all message alerts


Index: GIO.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO.hs,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** GIO.hs	26 Mar 2003 08:54:55 -0000	1.7
--- GIO.hs	26 Mar 2003 10:38:33 -0000	1.8
***************
*** 22,26 ****
             , module Graphics.UI.GIO.Canvas
             , module Graphics.UI.GIO.Events
!            , module Graphics.UI.GIO.FileDialog
             , module Graphics.UI.GIO.Window
             , module Graphics.UI.GIO.Timer
--- 22,27 ----
             , module Graphics.UI.GIO.Canvas
             , module Graphics.UI.GIO.Events
!            , module Graphics.UI.GIO.CommonDialogs
!            , module Graphics.UI.GIO.Messages
             , module Graphics.UI.GIO.Window
             , module Graphics.UI.GIO.Timer
***************
*** 39,43 ****
  import Graphics.UI.GIO.Canvas
  import Graphics.UI.GIO.Events
! import Graphics.UI.GIO.FileDialog
  import Graphics.UI.GIO.Window
  import Graphics.UI.GIO.Timer
--- 40,45 ----
  import Graphics.UI.GIO.Canvas
  import Graphics.UI.GIO.Events
! import Graphics.UI.GIO.CommonDialogs
! import Graphics.UI.GIO.Messages
  import Graphics.UI.GIO.Window
  import Graphics.UI.GIO.Timer

[htoolkit-cvs] gio makefile,1.6,1.7

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

Update of /cvsroot/htoolkit/gio
In directory sc8-pr-cvs1:/tmp/cvs-serv11160

Modified Files:
	makefile 
Log Message:
FileDialog module is renamed to CommonDialogs. The CommonDialog exports all file related dialogs and dialogs for Font and Color selection. The Messages module exports all message alerts


Index: makefile
===================================================================
RCS file: /cvsroot/htoolkit/gio/makefile,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** makefile	30 Jan 2003 23:58:14 -0000	1.6
--- makefile	26 Mar 2003 10:38:32 -0000	1.7
***************
*** 1,4 ****
  #-----------------------------------------------------------------------
! #  Copyright 2001, Daan Leijen. 
  #-----------------------------------------------------------------------
  
--- 1,4 ----
  #-----------------------------------------------------------------------
! #  Copyright 2003, Krasimir Angelov & Daan Leijen. 
  #-----------------------------------------------------------------------
  
***************
*** 35,39 ****
  	   GIO/Events.hs GIO/Timer.hs \
  	   GIO/Window.hs GIO/Menu.hs \
! 	   GIO/FileDialog.hs GIO/Controls.hs \
  	   GIO.hs \
  	   
--- 35,40 ----
  	   GIO/Events.hs GIO/Timer.hs \
  	   GIO/Window.hs GIO/Menu.hs \
! 	   GIO/CommonDialogs.hs GIO/Controls.hs \
! 	   GIO/Messages.hs \
  	   GIO.hs \
  	   

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

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

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

Modified Files:
	Attributes.hs Events.hs Window.hs 
Log Message:
Added support for ProcessDismiss and ProcessDestroy events


Index: Attributes.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Attributes.hs,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** Attributes.hs	25 Mar 2003 23:35:07 -0000	1.5
--- Attributes.hs	26 Mar 2003 08:54:55 -0000	1.6
***************
*** 40,44 ****
               -- * Attributes and properties
                 Attr, Prop
!              , set, get, with, (=:), (~:), (=::), (~::)
               
               -- * Common widget classes
--- 40,44 ----
               -- * Attributes and properties
                 Attr, Prop
!              , set1, set, get, with, (=:), (~:), (=::), (~::)
               
               -- * Common widget classes

Index: Events.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Events.hs,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** Events.hs	25 Mar 2003 23:37:02 -0000	1.5
--- Events.hs	26 Mar 2003 08:54:55 -0000	1.6
***************
*** 9,13 ****
  
      Many widgets can respond to /events/.
!     There are many basic events: 'closing', 'mouse', 'keyboard', 'paint', etc. Not
      all widgets respond to every event and the events are divided in seperate classes,
      like 'Reactive' and 'Commanding'.
--- 9,13 ----
  
      Many widgets can respond to /events/.
!     There are many basic events: 'mouse', 'keyboard', 'paint', etc. Not
      all widgets respond to every event and the events are divided in seperate classes,
      like 'Reactive' and 'Commanding'.
***************
*** 66,72 ****
               -- ** Reactive
               , Reactive
!              , closing, mouse, keyboard
               -- ** Form
!              , Form, dismiss, activate, deactivate, scroll, resize
               -- ** Paint
               , Paint, paint, repaint
--- 66,75 ----
               -- ** Reactive
               , Reactive
!              , mouse, keyboard
               -- ** Form
!              , Form, activate, deactivate, scroll, resize
!              -- ** Deadly
!              , Deadly
!              , destroy, dismiss
               -- ** Paint
               , Paint, paint, repaint
***************
*** 88,101 ****
               -- * Internal
               -- ** Standard events
!              -- *** Forms
!              , newDismissEvent
               , newActivateEvent
               , newDeactivateEvent
               , newScrollEvent
               , newResizeEvent
!              -- *** Reactive
!              , newClosingEvent
               , newMouseEvent
               , newKeyboardEvent
               -- *** Controls
               , newControlCommandEvent
--- 91,104 ----
               -- * Internal
               -- ** Standard events
!              -- *** Forms             
               , newActivateEvent
               , newDeactivateEvent
               , newScrollEvent
               , newResizeEvent
!              -- *** Reactive             
               , newMouseEvent
               , newKeyboardEvent
+              , newDismissEvent
+              , newDestroyEvent
               -- *** Controls
               , newControlCommandEvent
***************
*** 148,153 ****
  -- | A form is a visible window on the screen.
  class Form w where
-   -- | The 'dismiss' event is called when the user tries to close the form.
-   dismiss   :: Event w (IO ())
    activate  :: Event w (IO ())
    deactivate:: Event w (IO ())
--- 151,154 ----
***************
*** 155,163 ****
    resize    :: Event w (Size -> IO ())
  
! -- | Reactive widgets react to mouse and keyboard events and fire the 'closing' event
! -- when they are closed.
  class Reactive w where
-   -- | The closing event is triggered when a widget is closed.
-   closing   :: Event w (IO ())
    mouse     :: Event w (MouseEvent -> IO ())
    keyboard  :: Event w (KeyboardEvent -> IO ())
--- 156,168 ----
    resize    :: Event w (Size -> IO ())
  
! -- | The Deadly widgets can be destroyed and dissmissed
! class Deadly w where
!   -- | The 'dismiss' event is called when the user tries to close the form.
!   dismiss   :: Event w (IO ())
!   -- | The destroy event is triggered when a widget is destroied.
!   destroy   :: Event w (IO ())
! 
! -- | Reactive widgets react to mouse and keyboard events
  class Reactive w where
    mouse     :: Event w (MouseEvent -> IO ())
    keyboard  :: Event w (KeyboardEvent -> IO ())
***************
*** 318,324 ****
  --------------------------------------------------------------------}
  -- Forms
! newDismissEvent, newActivateEvent, newDeactivateEvent :: StdWindowEvent w (IO ())
! newDismissEvent   = stdWindowEvent Lib.getWindowDismissHandler    Lib.setWindowDismissHandler    Lib.setWindowDismissDefHandler
  newActivateEvent  = stdWindowEvent Lib.getWindowActivateHandler   Lib.setWindowActivateHandler   Lib.setWindowActivateDefHandler
  newDeactivateEvent= stdWindowEvent Lib.getWindowDeactivateHandler Lib.setWindowDeactivateHandler Lib.setWindowDeactivateDefHandler
  
--- 323,330 ----
  --------------------------------------------------------------------}
  -- Forms
! newActivateEvent  :: StdWindowEvent w (IO ())
  newActivateEvent  = stdWindowEvent Lib.getWindowActivateHandler   Lib.setWindowActivateHandler   Lib.setWindowActivateDefHandler
+ 
+ newDeactivateEvent:: StdWindowEvent w (IO ())
  newDeactivateEvent= stdWindowEvent Lib.getWindowDeactivateHandler Lib.setWindowDeactivateHandler Lib.setWindowDeactivateDefHandler
  
***************
*** 330,336 ****
  
  -- Reactive
- newClosingEvent   :: StdWindowEvent w (IO ())
- newClosingEvent   = stdWindowEvent Lib.getWindowDestroyHandler    Lib.setWindowDestroyHandler    Lib.setWindowDestroyDefHandler
- 
  newMouseEvent     :: StdWindowEvent w (MouseEvent -> IO ())
  newMouseEvent     = stdWindowEvent Lib.getWindowMouseHandler      Lib.setWindowMouseHandler      Lib.setWindowMouseDefHandler
--- 336,339 ----
***************
*** 339,342 ****
--- 342,352 ----
  newKeyboardEvent  = stdWindowEvent Lib.getWindowKeyboardHandler   Lib.setWindowKeyboardHandler   Lib.setWindowKeyboardDefHandler
  
+ -- Deadly
+ newDismissEvent   :: StdWindowEvent w (IO ())
+ newDismissEvent   = stdWindowEvent Lib.getWindowDismissHandler    Lib.setWindowDismissHandler    Lib.setWindowDismissDefHandler
+ 
+ newDestroyEvent   :: StdWindowEvent w (IO ())
+ newDestroyEvent   = stdWindowEvent Lib.getWindowDestroyHandler    Lib.setWindowDestroyHandler    Lib.setWindowDestroyDefHandler
+ 
  -- commands
  newControlCommandEvent :: StdWindowEvent w (IO ())
***************
*** 358,362 ****
  newMenuEvent getMenuHandle
    = newEvent (Lib.getMenuCommandHandler . getMenuHandle) (Lib.setMenuCommandHandler . getMenuHandle) (Lib.setMenuCommandDefHandler . getMenuHandle)
- 
  
  {--------------------------------------------------------------------
--- 368,371 ----

Index: Window.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Window.hs,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** Window.hs	25 Mar 2003 23:37:03 -0000	1.6
--- Window.hs	26 Mar 2003 08:54:55 -0000	1.7
***************
*** 173,186 ****
  
  instance Reactive Window where
-   closing   = newClosingEvent hwindow
    mouse     = newMouseEvent   hwindow
    keyboard  = newKeyboardEvent hwindow
  
! instance Form Window where  
!   dismiss   = newDismissEvent hwindow
    activate  = newActivateEvent hwindow
    deactivate= newDeactivateEvent hwindow
    scroll    = newScrollEvent hwindow
    resize    = newResizeEvent hwindow
  
  instance Paint Window where
--- 173,188 ----
  
  instance Reactive Window where
    mouse     = newMouseEvent   hwindow
    keyboard  = newKeyboardEvent hwindow
  
! instance Form Window where
    activate  = newActivateEvent hwindow
    deactivate= newDeactivateEvent hwindow
    scroll    = newScrollEvent hwindow
    resize    = newResizeEvent hwindow
+   
+ instance Deadly Window where
+   dismiss   = newDismissEvent hwindow
+   destroy   = newDestroyEvent hwindow
  
  instance Paint Window where

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

[htoolkit-cvs] port/src/Port Handlers.hs,1.15,1.16

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

Update of /cvsroot/htoolkit/port/src/Port
In directory sc8-pr-cvs1:/tmp/cvs-serv22470/src/Port

Modified Files:
	Handlers.hs 
Log Message:
Replace DestroyProcess with ProcessDestroy and DismissProcess with ProcessDestroy. This makes more consistent naming convention.


Index: Handlers.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Handlers.hs,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** Handlers.hs	26 Mar 2003 02:19:56 -0000	1.15
--- Handlers.hs	26 Mar 2003 08:45:52 -0000	1.16
***************
*** 53,58 ****
                  
                  -- * Process events
!                 ,setDismissProcessHandler, setDismissProcessDefHandler, getDismissProcessHandler
!                 ,setDestroyProcessHandler, setDestroyProcessDefHandler, getDestroyProcessHandler
  
                  -- * Control commands
--- 53,58 ----
                  
                  -- * Process events
!                 ,setProcessDismissHandler, setProcessDismissDefHandler, getProcessDismissHandler
!                 ,setProcessDestroyHandler, setProcessDestroyDefHandler, getProcessDestroyHandler
  
                  -- * Control commands
***************
*** 526,579 ****
  
  {-----------------------------------------------------------------------------------------
!   DismissProcess
  -----------------------------------------------------------------------------------------}
  
! {-# NOINLINE handlersDismissProcess #-}
! handlersDismissProcess :: MVar (IO ())
! handlersDismissProcess
    = unsafePerformIO (newMVar (return ()))
  
! setDismissProcessHandler :: IO () -> IO ()
! setDismissProcessHandler handler = do
! 	takeMVar handlersDismissProcess
! 	putMVar handlersDismissProcess handler
  
! setDismissProcessDefHandler :: IO ()
! setDismissProcessDefHandler = do
! 	takeMVar handlersDismissProcess
! 	putMVar handlersDismissProcess (return ())
  	
! getDismissProcessHandler :: IO (IO ())
! getDismissProcessHandler =
! 	readMVar handlersDismissProcess
  
! handleDismissProcess :: IO ()
! handleDismissProcess = readMVar handlersDismissProcess >>= id
  
  {-----------------------------------------------------------------------------------------
!   DestroyProcess
  -----------------------------------------------------------------------------------------}
  
! {-# NOINLINE handlersDestroyProcess #-}
! handlersDestroyProcess :: MVar (IO ())
! handlersDestroyProcess
    = unsafePerformIO (newMVar (return ()))
  
! setDestroyProcessHandler :: IO () -> IO ()
! setDestroyProcessHandler handler = do
! 	takeMVar handlersDestroyProcess
! 	putMVar handlersDestroyProcess handler
  
! setDestroyProcessDefHandler :: IO ()
! setDestroyProcessDefHandler = do
! 	takeMVar handlersDestroyProcess
! 	putMVar handlersDestroyProcess (return ())
  
! getDestroyProcessHandler :: IO (IO ())
! getDestroyProcessHandler =
! 	readMVar handlersDismissProcess
  	
! handleDestroyProcess :: IO ()
! handleDestroyProcess = readMVar handlersDestroyProcess >>= id
  
  {-----------------------------------------------------------------------------------------
--- 526,579 ----
  
  {-----------------------------------------------------------------------------------------
!   ProcessDismiss
  -----------------------------------------------------------------------------------------}
  
! {-# NOINLINE handlersProcessDismiss #-}
! handlersProcessDismiss :: MVar (IO ())
! handlersProcessDismiss
    = unsafePerformIO (newMVar (return ()))
  
! setProcessDismissHandler :: IO () -> IO ()
! setProcessDismissHandler handler = do
! 	takeMVar handlersProcessDismiss
! 	putMVar  handlersProcessDismiss handler
  
! setProcessDismissDefHandler :: IO ()
! setProcessDismissDefHandler = do
! 	takeMVar handlersProcessDismiss
! 	putMVar  handlersProcessDismiss (return ())
  	
! getProcessDismissHandler :: IO (IO ())
! getProcessDismissHandler =
! 	readMVar handlersProcessDismiss
  
! handleProcessDismiss :: IO ()
! handleProcessDismiss = readMVar handlersProcessDismiss >>= id
  
  {-----------------------------------------------------------------------------------------
!   ProcessDestroy
  -----------------------------------------------------------------------------------------}
  
! {-# NOINLINE handlersProcessDestroy #-}
! handlersProcessDestroy :: MVar (IO ())
! handlersProcessDestroy
    = unsafePerformIO (newMVar (return ()))
  
! setProcessDestroyHandler :: IO () -> IO ()
! setProcessDestroyHandler handler = do
! 	takeMVar handlersProcessDestroy
! 	putMVar  handlersProcessDestroy handler
  
! setProcessDestroyDefHandler :: IO ()
! setProcessDestroyDefHandler = do
! 	takeMVar handlersProcessDestroy
! 	putMVar  handlersProcessDestroy (return ())
  
! getProcessDestroyHandler :: IO (IO ())
! getProcessDestroyHandler =
! 	readMVar handlersProcessDestroy
  	
! handleProcessDestroy :: IO ()
! handleProcessDestroy = readMVar handlersProcessDestroy >>= id
  
  {-----------------------------------------------------------------------------------------
***************
*** 621,624 ****
  foreign export ccall handleMenusUpdate :: IO ()
  foreign export ccall handleTimer :: TimerHandle -> IO ()
! foreign export ccall handleDismissProcess :: IO ()
! foreign export ccall handleDestroyProcess :: IO ()
\ No newline at end of file
--- 621,624 ----
  foreign export ccall handleMenusUpdate :: IO ()
  foreign export ccall handleTimer :: TimerHandle -> IO ()
! foreign export ccall handleProcessDismiss :: IO ()
! foreign export ccall handleProcessDestroy :: IO ()
\ No newline at end of file

[htoolkit-cvs] port/src Port.hs,1.12,1.13

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

Update of /cvsroot/htoolkit/port/src
In directory sc8-pr-cvs1:/tmp/cvs-serv22470/src

Modified Files:
	Port.hs 
Log Message:
Replace DestroyProcess with ProcessDestroy and DismissProcess with ProcessDestroy. This makes more consistent naming convention.


Index: Port.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port.hs,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** Port.hs	24 Mar 2003 16:58:32 -0000	1.12
--- Port.hs	26 Mar 2003 08:45:51 -0000	1.13
***************
*** 84,88 ****
  start appName di io = do
  	withCString appName (\s -> osInit s (toCDocumentInterface di))
! 	setDismissProcessHandler quit
  	r <- io
  	osStart
--- 84,88 ----
  start appName di io = do
  	withCString appName (\s -> osInit s (toCDocumentInterface di))
! 	setProcessDismissHandler quit
  	r <- io
  	osStart

[htoolkit-cvs] port/src/cbits/GTK Frame.c,1.1,1.2 Util.c,1.8,1.9

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

Update of /cvsroot/htoolkit/port/src/cbits/GTK
In directory sc8-pr-cvs1:/tmp/cvs-serv22470/src/cbits/GTK

Modified Files:
	Frame.c Util.c 
Log Message:
Replace DestroyProcess with ProcessDestroy and DismissProcess with ProcessDestroy. This makes more consistent naming convention.


Index: Frame.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/GTK/Frame.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Frame.c	3 Mar 2003 19:03:23 -0000	1.1
--- Frame.c	26 Mar 2003 08:45:52 -0000	1.2
***************
*** 45,49 ****
  static gboolean frame_delete_handler(GtkWidget *widget, GdkEvent *event, gpointer user_data)
  {
! 	handleDismissProcess();
  	return gtk_true();
  }
--- 45,49 ----
  static gboolean frame_delete_handler(GtkWidget *widget, GdkEvent *event, gpointer user_data)
  {
! 	handleProcessDismiss();
  	return gtk_true();
  }

Index: Util.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/GTK/Util.c,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** Util.c	24 Mar 2003 15:40:41 -0000	1.8
--- Util.c	26 Mar 2003 08:45:54 -0000	1.9
***************
*** 72,76 ****
  	}
  
! 	handleDestroyProcess();
  
  	free(gAppName);
--- 72,76 ----
  	}
  
! 	handleProcessDestroy();
  
  	free(gAppName);

[htoolkit-cvs] port/src/cbits/Win32 Frame.c,1.1,1.2 Util.c,1.7,1.8

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

Update of /cvsroot/htoolkit/port/src/cbits/Win32
In directory sc8-pr-cvs1:/tmp/cvs-serv22470/src/cbits/Win32

Modified Files:
	Frame.c Util.c 
Log Message:
Replace DestroyProcess with ProcessDestroy and DismissProcess with ProcessDestroy. This makes more consistent naming convention.


Index: Frame.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/Win32/Frame.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Frame.c	10 Feb 2003 22:42:10 -0000	1.1
--- Frame.c	26 Mar 2003 08:45:54 -0000	1.2
***************
*** 9,13 ****
  	{
  	case WM_CLOSE:
! 		handleDismissProcess();
  		return 0;
  	case WM_CREATE:
--- 9,13 ----
  	{
  	case WM_CLOSE:
! 		handleProcessDismiss();
  		return 0;
  	case WM_CREATE:

Index: Util.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/Win32/Util.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** Util.c	24 Mar 2003 15:40:42 -0000	1.7
--- Util.c	26 Mar 2003 08:45:56 -0000	1.8
***************
*** 200,204 ****
  	}
  
! 	handleDestroyProcess();
  
  	doneGdiPlus();
--- 200,204 ----
  	}
  
! 	handleProcessDestroy();
  
  	doneGdiPlus();

[htoolkit-cvs] gio/src/Graphics/UI/GIO Timer.hs,1.3,1.4

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

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

Modified Files:
	Timer.hs 
Log Message:
default interval = 0


Index: Timer.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Timer.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Timer.hs	26 Mar 2003 02:19:56 -0000	1.3
--- Timer.hs	26 Mar 2003 02:23:24 -0000	1.4
***************
*** 33,37 ****
  timer :: [Prop Timer] -> IO Timer
  timer props
!   = do vtimer <- Lib.createTimer 1000
         let t = Timer vtimer
         set t props
--- 33,37 ----
  timer :: [Prop Timer] -> IO Timer
  timer props
!   = do vtimer <- Lib.createTimer 0
         let t = Timer vtimer
         set t props

[htoolkit-cvs] port/src/include Timer.h,1.1,1.2 Types.h,1.5,1.6

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

Update of /cvsroot/htoolkit/port/src/include
In directory sc8-pr-cvs1:/tmp/cvs-serv5945/port/src/include

Modified Files:
	Timer.h Types.h 
Log Message:
Efficient implementation for timers


Index: Timer.h
===================================================================
RCS file: /cvsroot/htoolkit/port/src/include/Timer.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Timer.h	21 Jan 2003 22:01:17 -0000	1.1
--- Timer.h	26 Mar 2003 02:19:57 -0000	1.2
***************
*** 6,9 ****
--- 6,13 ----
  TimerHandle osCreateTimer(int msecs);
  void osDestroyTimer(TimerHandle timer);
+ void osSetTimerInterval(TimerHandle timer, int msecs);
+ int  osGetTimerInterval(TimerHandle timer);
+ void osEnableTimer(TimerHandle timer, BOOL enabled);
+ BOOL osIsTimerEnabled(TimerHandle timer);
  
  #endif

Index: Types.h
===================================================================
RCS file: /cvsroot/htoolkit/port/src/include/Types.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** Types.h	10 Feb 2003 22:42:11 -0000	1.5
--- Types.h	26 Mar 2003 02:19:57 -0000	1.6
***************
*** 17,21 ****
  
  typedef HWND WindowHandle;
! typedef void* TimerHandle;
  
  typedef struct
--- 17,27 ----
  
  typedef HWND WindowHandle;
! 
! typedef struct
! {
! 	UINT_PTR id;
! 	int interval;
! 	BOOL enabled;
! } *TimerHandle;
  
  typedef struct
***************
*** 61,65 ****
  
  typedef GtkWidget   *WindowHandle;
! typedef guint       *TimerHandle;
  
  typedef struct
--- 67,77 ----
  
  typedef GtkWidget   *WindowHandle;
! 
! typedef struct
! {
! 	guint id;
! 	int interval;
! 	BOOL enabled;
! } *TimerHandle;
  
  typedef struct

[htoolkit-cvs] port/src/cbits/Win32 Timer.c,1.2,1.3

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

Update of /cvsroot/htoolkit/port/src/cbits/Win32
In directory sc8-pr-cvs1:/tmp/cvs-serv5945/port/src/cbits/Win32

Modified Files:
	Timer.c 
Log Message:
Efficient implementation for timers


Index: Timer.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/Win32/Timer.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Timer.c	10 Feb 2003 22:42:10 -0000	1.2
--- Timer.c	26 Mar 2003 02:19:57 -0000	1.3
***************
*** 3,22 ****
  #include "Internals.h"
  
! static VOID CALLBACK osTimerProc(HWND hwnd, UINT msg, UINT_PTR timer, DWORD time)
  {
! 	handleTimer((TimerHandle) timer);
  }
  
  TimerHandle osCreateTimer(int msecs)
  {
! 	TimerHandle r = (TimerHandle)SetTimer( NULL, 0, msecs, osTimerProc );
! 	if (!r)
  	{
! 		printf( "Timer: failed to create timer\n" );
! 		return NULL;
! 	}
  
  	gActiveObjects++;
! 	return r;
  }
  
--- 3,61 ----
  #include "Internals.h"
  
! static HWND ghTimerWnd = NULL;
! 
! static LRESULT CALLBACK HTimerWindowFunction(HWND hWnd, UINT uMsg, WPARAM wParam, LPARAM lParam)
  {
! 	switch (uMsg)
! 	{
! 	case WM_TIMER:
! 		{
! 			TimerHandle timer = (TimerHandle) wParam;
! 			if (timer->enabled) handleTimer(timer);
! 		}
! 		return 0;
! 	default:
! 		return DefWindowProc(hWnd, uMsg, wParam, lParam);
! 	}
  }
  
  TimerHandle osCreateTimer(int msecs)
  {
! 	TimerHandle timer;
! 
! 	if (!ghTimerWnd)
  	{
! 		WNDCLASS wc;
! 
! 		wc.style = CS_DBLCLKS;
! 		wc.lpfnWndProc = HTimerWindowFunction;
! 		wc.cbClsExtra = 0;
! 		wc.cbWndExtra = 0;
! 		wc.hInstance  = ghModule;
! 		wc.hIcon = NULL;
! 		wc.hCursor = NULL;
! 		wc.hbrBackground = NULL;
! 		wc.lpszMenuName = NULL;
! 		wc.lpszClassName = "HTIMERWINDOW";
! 		RegisterClass(&wc);
! 
! 		ghTimerWnd = CreateWindow(
! 					  "HTIMERWINDOW",
! 					  NULL,
! 					  0,
! 					  CW_USEDEFAULT,0,0,0,
! 					  NULL,
! 					  NULL,
! 					  ghModule,
! 					  NULL
! 					);
! 	};
  
+ 	timer = (TimerHandle) rmalloc(sizeof(*timer));
+ 	timer->interval = msecs;
+ 	timer->enabled  = TRUE;
+ 	timer->id = (msecs > 0) ? SetTimer(ghTimerWnd, (WPARAM) timer, msecs, NULL) : 0;
  	gActiveObjects++;
! 	return timer;
  }
  
***************
*** 25,31 ****
  	if (timer!=NULL)
  	{
! 		KillTimer(NULL,(UINT_PTR)timer);
  		gActiveObjects--;
  	}
  }
  
--- 64,111 ----
  	if (timer!=NULL)
  	{
! 		if (timer->id > 0)
! 		  KillTimer(ghTimerWnd,timer->id);
! 		rfree(timer);
  		gActiveObjects--;
  	}
  }
  
+ void osSetTimerInterval(TimerHandle timer, int msecs)
+ {
+ 	if (timer->interval != msecs)
+ 	{
+ 		timer->interval = msecs;
+ 		if (timer->enabled)
+ 		{
+ 			if (timer->id > 0)
+ 				KillTimer(ghTimerWnd,timer->id);
+ 			timer->id = (msecs > 0) ? SetTimer(ghTimerWnd, (WPARAM) timer, msecs, NULL) : 0;
+ 		}
+ 	}
+ };
+ 
+ int osGetTimerInterval(TimerHandle timer)
+ {
+ 	return timer->interval;
+ };
+ 
+ void osEnableTimer(TimerHandle timer, BOOL enabled)
+ {
+ 	timer->enabled = enabled;
+ 	if (timer->enabled)
+ 	{
+ 		if (timer->id <= 0 && timer->interval > 0)
+ 			timer->id = SetTimer(ghTimerWnd, (WPARAM) timer, timer->interval, NULL);
+ 	}
+ 	else
+ 	{
+ 		if (timer->id > 0)
+ 		  KillTimer(ghTimerWnd,timer->id);
+ 		timer->id = 0;
+ 	}
+ };
+ 
+ BOOL osIsTimerEnabled(TimerHandle timer)
+ {
+ 	return timer->enabled;
+ };

[htoolkit-cvs] port/src/Port Handlers.hs,1.14,1.15 Timer.hs,1.1,1.2

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

Update of /cvsroot/htoolkit/port/src/Port
In directory sc8-pr-cvs1:/tmp/cvs-serv5945/port/src/Port

Modified Files:
	Handlers.hs Timer.hs 
Log Message:
Efficient implementation for timers


Index: Handlers.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Handlers.hs,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** Handlers.hs	25 Mar 2003 23:23:34 -0000	1.14
--- Handlers.hs	26 Mar 2003 02:19:56 -0000	1.15
***************
*** 32,36 ****
                  
                  -- * Timers
!                 ,registerTimer,  unregisterTimer, getAllTimerHandles
                  
                  -- * Windows
--- 32,36 ----
                  
                  -- * Timers
!                 ,setTimerHandler, setTimerDefHandler, getTimerHandler, getAllTimerHandles
                  
                  -- * Windows
***************
*** 589,599 ****
    = invokeHandler htimer handlersTimer id
  
! registerTimer :: TimerHandle -> IO () -> IO ()
! registerTimer htimer handler
    = setHandler htimer handler handlersTimer
  
! unregisterTimer :: TimerHandle -> IO ()
! unregisterTimer htimer
    = setDefHandler htimer handlersTimer
  
  getAllTimerHandles :: IO [TimerHandle]
--- 589,603 ----
    = invokeHandler htimer handlersTimer id
  
! setTimerHandler :: TimerHandle -> IO () -> IO ()
! setTimerHandler htimer handler
    = setHandler htimer handler handlersTimer
  
! setTimerDefHandler :: TimerHandle -> IO ()
! setTimerDefHandler htimer
    = setDefHandler htimer handlersTimer
+   
+ getTimerHandler :: TimerHandle -> IO (IO ())
+ getTimerHandler htimer
+   = getHandler htimer (return ()) handlersTimer
  
  getAllTimerHandles :: IO [TimerHandle]

Index: Timer.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Timer.hs,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Timer.hs	17 Feb 2003 23:08:17 -0000	1.1
--- Timer.hs	26 Mar 2003 02:19:57 -0000	1.2
***************
*** 16,45 ****
  module Graphics.UI.Port.Timer
  	( createTimer, destroyTimer
  	, getAllTimerHandles, destroyAllTimers
  	) where
  
- import Prelude hiding (lookup)
  import Graphics.UI.Port.Types
! import Graphics.UI.Port.PtrMap
! import Graphics.UI.Port.Handlers(registerTimer, unregisterTimer, getAllTimerHandles)
! import System.IO.Unsafe( unsafePerformIO )
! import Control.Concurrent.MVar
  
  -- | Create a timer with a handler that is called on a specified milli-second interval.
! createTimer :: Int -> IO () -> IO TimerHandle
! createTimer msecs handler = do
! 	htimer <- osCreateTimer msecs
! 	registerTimer htimer handler
! 	return htimer
! foreign import ccall osCreateTimer :: Int -> IO TimerHandle
  
  -- | Destroy a timer and automatically unregister its event handler.
  destroyTimer :: TimerHandle -> IO ()
  destroyTimer htimer = do
! 	unregisterTimer htimer
! 	osDestroyTimer htimer	
  foreign import ccall osDestroyTimer :: TimerHandle -> IO ()
  
  -- Destroy all timers (called by quit).
  destroyAllTimers :: IO ()
! destroyAllTimers = getAllTimerHandles >>= mapM_ osDestroyTimer
--- 16,50 ----
  module Graphics.UI.Port.Timer
  	( createTimer, destroyTimer
+ 	, setTimerInterval, getTimerInterval
+ 	, enableTimer, isTimerEnabled
  	, getAllTimerHandles, destroyAllTimers
  	) where
  
  import Graphics.UI.Port.Types
! import Graphics.UI.Port.Handlers(setTimerDefHandler, getAllTimerHandles)
  
  -- | Create a timer with a handler that is called on a specified milli-second interval.
! foreign import ccall "osCreateTimer" createTimer :: Int -> IO TimerHandle
  
  -- | Destroy a timer and automatically unregister its event handler.
  destroyTimer :: TimerHandle -> IO ()
  destroyTimer htimer = do
! 	setTimerDefHandler htimer
! 	osDestroyTimer htimer
  foreign import ccall osDestroyTimer :: TimerHandle -> IO ()
  
+ -- | Change the delay time for the timer
+ foreign import ccall "osSetTimerInterval" setTimerInterval :: TimerHandle -> Int -> IO ()
+ 
+ -- | Get the delay time for the timer
+ foreign import ccall "osGetTimerInterval" getTimerInterval :: TimerHandle -> IO Int 
+ 
+ -- | Enable\/disable timer
+ foreign import ccall "osEnableTimer" enableTimer :: TimerHandle -> Bool -> IO ()
+ 
+ -- | Returns True when the timer is enabled.
+ foreign import ccall "osIsTimerEnabled" isTimerEnabled :: TimerHandle -> IO Bool
+ 
  -- Destroy all timers (called by quit).
  destroyAllTimers :: IO ()
! destroyAllTimers = getAllTimerHandles >>= mapM_ destroyTimer

[htoolkit-cvs] port/src/cbits/GTK Timer.c,1.3,1.4

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

Update of /cvsroot/htoolkit/port/src/cbits/GTK
In directory sc8-pr-cvs1:/tmp/cvs-serv5945/port/src/cbits/GTK

Modified Files:
	Timer.c 
Log Message:
Efficient implementation for timers


Index: Timer.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/GTK/Timer.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Timer.c	10 Feb 2003 22:42:09 -0000	1.3
--- Timer.c	26 Mar 2003 02:19:57 -0000	1.4
***************
*** 3,7 ****
  #include "Internals.h"
  
! static gboolean osTimerProc( gpointer data )
  {
    handleTimer((TimerHandle) data);
--- 3,7 ----
  #include "Internals.h"
  
! static gboolean osTimerProc(gpointer data)
  {
    handleTimer((TimerHandle) data);
***************
*** 9,20 ****
  }
  
! TimerHandle osCreateTimer( int msecs )
  {
! 	guint      timerid;
! 	TimerHandle timer = rmalloc( sizeof(guint) );
! 
! 	*timer = 0;
! 	timerid = gtk_timeout_add( msecs, osTimerProc, timer );
! 	*timer = timerid;
  
  	gActiveObjects++;
--- 9,18 ----
  }
  
! TimerHandle osCreateTimer(int msecs)
  {
! 	TimerHandle timer = rmalloc(sizeof(*timer));
! 	timer->interval = msecs;
! 	timer->enabled  = TRUE;
! 	timer->id = (msecs > 0) ? gtk_timeout_add(msecs, osTimerProc, timer) : 0;
  
  	gActiveObjects++;
***************
*** 22,32 ****
  }
  
! void osDestroyTimer( TimerHandle timer )
  {
  	if (timer!=NULL)
  	{
! 		gtk_timeout_remove( *timer );
  		rfree(timer);
  		gActiveObjects--;
  	}
  }
--- 20,71 ----
  }
  
! void osDestroyTimer(TimerHandle timer)
  {
  	if (timer!=NULL)
  	{
! 		if (timer->id > 0)
! 			gtk_timeout_remove(timer->id);
  		rfree(timer);
  		gActiveObjects--;
  	}
  }
+ 
+ void osSetTimerInterval(TimerHandle timer, int msecs)
+ {
+ 	if (timer->interval != msecs)
+ 	{
+ 		timer->interval = msecs;
+ 		if (timer->enabled)
+ 		{
+ 			if (timer->id > 0)
+ 				gtk_timeout_remove(timer->id);
+ 			timer->id = (msecs > 0) gtk_timeout_add(msecs, osTimerProc, timer) : 0;
+ 		}
+ 	}
+ };
+ 
+ int osGetTimerInterval(TimerHandle timer)
+ {
+ 	return timer->interval;
+ };
+ 
+ void osEnableTimer(TimerHandle timer, BOOL enabled)
+ {
+ 	timer->enabled = enabled;
+ 	if (timer->enabled)
+ 	{
+ 		if (timer->id <= 0 && timer->interval > 0)
+ 			timer->id = gtk_timeout_add(msecs, osTimerProc, timer);
+ 	}
+ 	else
+ 	{
+ 		if (timer->id > 0)
+ 		  gtk_timeout_remove(timer->id);
+ 		timer->id = 0;
+ 	}
+ };
+ 
+ BOOL osIsTimerEnabled(TimerHandle timer)
+ {
+ 	return timer->enabled;
+ };

[htoolkit-cvs] gio/src/Graphics/UI/GIO Timer.hs,1.2,1.3

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

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

Modified Files:
	Timer.hs 
Log Message:
Efficient implementation for timers


Index: Timer.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Timer.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Timer.hs	25 Mar 2003 23:37:03 -0000	1.2
--- Timer.hs	26 Mar 2003 02:19:56 -0000	1.3
***************
*** 26,111 ****
  --------------------------------------------------------------------}
  -- | A timer generates a 'command' event on a specified milli-second 'interval'.
! data Timer  = Timer{ vtimer     :: Var (Maybe TimerHandle)
!                    , vinterval  :: Var Int
!                    , vcommand   :: Var (Maybe (IO ()))
!                    , venabled   :: Var Bool
!                    }
  
  -- | Create a new timer with a 1 second interval.
  timer :: [Prop Timer] -> IO Timer
  timer props
!   = do t <- do vtimer    <- newVar Nothing
!                vinterval <- newVar 1000
!                vcommand  <- newVar Nothing
!                venabled  <- newVar True
!                return (Timer vtimer vinterval vcommand venabled)
         set t props
         return t
  
! -- update the timer state
! updateTimer :: Timer -> IO ()
! updateTimer t
!   = do enable  <- getVar (venabled t)
!        mbcmd   <- getVar (vcommand t)
!        mbtimer <- getVar (vtimer t)
!        case (enable,mbcmd,mbtimer) of
!         (True,Just cmd,_)
!           -> do case mbtimer of
!                   Nothing -> return ()
!                   Just h  -> Lib.destroyTimer h
!                 interv <- getVar (vinterval t)
!                 htimer <- Lib.createTimer interv cmd
!                 setVar (vtimer t) (Just htimer)
!         (_,_,Just htimer)
!           -> do Lib.destroyTimer htimer
!                 setVar (vtimer t) (Nothing)
!         other
!           -> return ()
! 
! -- | The milli-second interval of the timer.
  interval :: Attr Timer Int
! interval
!   = newAttr (\t   -> getVar (vinterval t))
!             (\t i -> do oldi <- getVar (vinterval t)
!                         when (i /= oldi) (
!                            do setVar (vinterval t) i
!                               updateTimer t))
  
  instance Able Timer where
!   enabled  
!     = newAttr getter setter
!     where
!       getter t 
!         = do getVar (venabled t)
! 
!       setter t enable
!         = do able <- getVar (venabled t)
!              when (able /= enable) (
!                 do setVar (venabled t) enable
!                    updateTimer t)
! 
                    
  instance Commanding Timer where
!   command  
!     = newEvent getter setter setdef
!     where
!       getter t
!         = do mbcmd <- getVar (vcommand t)
!              case mbcmd of
!                Nothing  -> return (return ())
!                Just cmd -> return cmd
! 
!       setter t cmd
!         = do setVar (vcommand t) (Just cmd)
!              updateTimer t
!              
!       setdef t 
!         = do mbtimer <- takeVar (vtimer t)
!              case mbtimer of
!                Nothing -> return ()
!                Just h  -> Lib.destroyTimer h
!              putVar (vtimer t) Nothing
! 
! {--------------------------------------------------------------------
  
! --------------------------------------------------------------------}
--- 26,51 ----
  --------------------------------------------------------------------}
  -- | A timer generates a 'command' event on a specified milli-second 'interval'.
! newtype Timer = Timer TimerHandle
! 
! getTimerHandle (Timer thandle) = thandle
  
  -- | Create a new timer with a 1 second interval.
  timer :: [Prop Timer] -> IO Timer
  timer props
!   = do vtimer <- Lib.createTimer 1000
!        let t = Timer vtimer
         set t props
         return t
  
! -- | The milli-second interval of the timer. The interval should be greather than zero.
  interval :: Attr Timer Int
! interval = newAttr (Lib.getTimerInterval . getTimerHandle) (Lib.setTimerInterval . getTimerHandle)
  
  instance Able Timer where
!   enabled = newAttr (Lib.isTimerEnabled . getTimerHandle) (Lib.enableTimer . getTimerHandle)
                    
  instance Commanding Timer where
!   command = newEvent (Lib.getTimerHandler . getTimerHandle) (Lib.setTimerHandler . getTimerHandle) (Lib.setTimerDefHandler . getTimerHandle)
  
! destroyTimer :: Timer -> IO ()
! destroyTimer = Lib.destroyTimer . getTimerHandle
\ No newline at end of file

[htoolkit-cvs] port/src/cbits/GTK Button.c,1.3,1.4

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

Update of /cvsroot/htoolkit/port/src/cbits/GTK
In directory sc8-pr-cvs1:/tmp/cvs-serv7613/src/cbits/GTK

Modified Files:
	Button.c 
Log Message:
BUGFIX: handleButtonClick function is replaced with handleControlCommand


Index: Button.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/GTK/Button.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Button.c	10 Feb 2003 22:42:09 -0000	1.3
--- Button.c	26 Mar 2003 00:41:47 -0000	1.4
***************
*** 10,14 ****
  	button = gtk_button_new_with_mnemonic("");
  	gtk_signal_connect (GTK_OBJECT(button), "clicked",
! 			GTK_SIGNAL_FUNC(handleButtonClick),
  			NULL);
  	gtk_fixed_put(GTK_FIXED(GTK_BIN(GetSW(window)->child)->child), button, 0, 0);
--- 10,14 ----
  	button = gtk_button_new_with_mnemonic("");
  	gtk_signal_connect (GTK_OBJECT(button), "clicked",
! 			GTK_SIGNAL_FUNC(handleControlCommand),
  			NULL);
  	gtk_fixed_put(GTK_FIXED(GTK_BIN(GetSW(window)->child)->child), button, 0, 0);

[htoolkit-cvs] port/src/cbits/Win32 Window.c,1.10,1.11

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

Update of /cvsroot/htoolkit/port/src/cbits/Win32
In directory sc8-pr-cvs1:/tmp/cvs-serv7613/src/cbits/Win32

Modified Files:
	Window.c 
Log Message:
BUGFIX: handleButtonClick function is replaced with handleControlCommand


Index: Window.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/Win32/Window.c,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** Window.c	24 Mar 2003 17:07:09 -0000	1.10
--- Window.c	26 Mar 2003 00:41:46 -0000	1.11
***************
*** 204,216 ****
                  else
                      if (_stricmp(buffer, "Button") == 0)
!                     {
!                         if ((GetWindowLong(hCtrl,GWL_STYLE) & BS_AUTORADIOBUTTON) == BS_AUTORADIOBUTTON)
!                             handleControlCommand(hCtrl);
!                         else
!                             if ((GetWindowLong(hCtrl,GWL_STYLE) & BS_AUTOCHECKBOX) == BS_AUTOCHECKBOX)
!                                 handleControlCommand(hCtrl);
!                             else
!                                 handleButtonClick(hCtrl);
!                     }
          }
          else
--- 204,208 ----
                  else
                      if (_stricmp(buffer, "Button") == 0)
! 						handleControlCommand(hCtrl);
          }
          else

[htoolkit-cvs] gio/src/Graphics/UI/GIO Controls.hs,1.3,1.4 Events.hs,1.4,1.5 Menu.hs,1.2,1.3 Timer.hs,1.1.1.1,1.2 Window.hs,1.5,1.6

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

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

Modified Files:
	Controls.hs Events.hs Menu.hs Timer.hs Window.hs 
Log Message:
The new implementation of Events allows usage of setHandler/setDefHandler/getHandler functional tripple


Index: Controls.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Controls.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Controls.hs	29 Jan 2003 16:16:06 -0000	1.3
--- Controls.hs	25 Mar 2003 23:37:01 -0000	1.4
***************
*** 35,40 ****
  --------------------------------------------------------------------}
  -- | A simple text label.
! data Label    = Label { lhandle :: WindowHandle
!                       , lparent :: WindowHandle
                        }
  
--- 35,40 ----
  --------------------------------------------------------------------}
  -- | A simple text label.
! data Label    = Label { lhandle :: !WindowHandle
!                       , lparent :: !WindowHandle
                        }
  
***************
*** 65,71 ****
  --------------------------------------------------------------------}
  -- | A standard push button.
! data Button   = Button { bhandle :: WindowHandle
!                        , bparent :: WindowHandle
!                        , bcommand :: EventHandler (IO ()) }
  
  -- | Create a button.
--- 65,71 ----
  --------------------------------------------------------------------}
  -- | A standard push button.
! data Button   = Button { bhandle :: !WindowHandle
!                        , bparent :: !WindowHandle
!                        }
  
  -- | Create a button.
***************
*** 74,79 ****
    = do but <- do hwnd <- get w windowHandle
                   hbut <- Port.createButton hwnd
!                  bcmd <- newEventHandler 
!                  return (Button hbut hwnd bcmd)
         set but props
         return but
--- 74,78 ----
    = do but <- do hwnd <- get w windowHandle
                   hbut <- Port.createButton hwnd
!                  return (Button hbut hwnd)
         set but props
         return but
***************
*** 95,99 ****
  instance Commanding Button where
    command
!     = newButtonClickEvent bhandle bcommand
  
  {--------------------------------------------------------------------
--- 94,98 ----
  instance Commanding Button where
    command
!     = newControlCommandEvent bhandle
  
  {--------------------------------------------------------------------
***************
*** 101,106 ****
  --------------------------------------------------------------------}
  -- | A standard text entry control.
! data Entry   = Entry { ehandle :: WindowHandle
!                      , eparent :: WindowHandle
                       }
  
--- 100,105 ----
  --------------------------------------------------------------------}
  -- | A standard text entry control.
! data Entry   = Entry { ehandle :: !WindowHandle
!                      , eparent :: !WindowHandle
                       }
  
***************
*** 135,141 ****
  -- command handler automatically calls a handler associated with a
  -- selected item.
! data Popup  = Popup    { phandle  :: WindowHandle
!                        , pparent  :: WindowHandle
!                        , pcommand :: EventHandler (IO ())
                         , pitems   :: Var [(String,IO ())]
                         }
--- 134,139 ----
  -- command handler automatically calls a handler associated with a
  -- selected item.
! data Popup  = Popup    { phandle  :: !WindowHandle
!                        , pparent  :: !WindowHandle
                         , pitems   :: Var [(String,IO ())]
                         }
***************
*** 146,152 ****
    = do p <- do hwnd <- get w windowHandle
                 hpop <- Port.createPopUp hwnd
-                pcmd <- newEventHandler 
                 pitems <- newVar []
!                return (Popup hpop hwnd pcmd pitems)       
         set p [on command =: popupCommand p]
         set p props
--- 144,149 ----
    = do p <- do hwnd <- get w windowHandle
                 hpop <- Port.createPopUp hwnd
                 pitems <- newVar []
!                return (Popup hpop hwnd pitems)       
         set p [on command =: popupCommand p]
         set p props
***************
*** 188,192 ****
  instance Commanding Popup where
    command
!     = newPopupClickEvent phandle pcommand
  
  {--------------------------------------------------------------------
--- 185,189 ----
  instance Commanding Popup where
    command
!     = newControlCommandEvent phandle
  
  {--------------------------------------------------------------------
***************
*** 195,199 ****
  -- | A check control group. 
  data CheckGroup = CheckGroup{ checks   :: [Check]
!                             , cgparent :: WindowHandle
                              , cglayout :: Var ([Check] -> Layout)
                              }
--- 192,196 ----
  -- | A check control group. 
  data CheckGroup = CheckGroup{ checks   :: [Check]
!                             , cgparent :: !WindowHandle
                              , cglayout :: Var ([Check] -> Layout)
                              }
***************
*** 251,255 ****
  data RadioGroup = RadioGroup{ radios  :: [Radio]
                              , commands:: [IO ()]
!                             , gparent :: WindowHandle
                              , gselect :: Var Int
                              , glayout :: Var ([Radio] -> Layout)
--- 248,252 ----
  data RadioGroup = RadioGroup{ radios  :: [Radio]
                              , commands:: [IO ()]
!                             , gparent :: !WindowHandle
                              , gselect :: Var Int
                              , glayout :: Var ([Radio] -> Layout)
***************
*** 308,314 ****
  --------------------------------------------------------------------}
  -- | A single check control.
! data Check    = Check{ chandle :: WindowHandle
!                      , cparent :: WindowHandle
!                      , ccommand :: EventHandler (IO ())
                       }
  
--- 305,310 ----
  --------------------------------------------------------------------}
  -- | A single check control.
! data Check    = Check{ chandle :: !WindowHandle
!                      , cparent :: !WindowHandle
                       }
  
***************
*** 318,323 ****
    = do c <- do hwnd   <- get w windowHandle
                 hcheck <- Port.createCheckBox hwnd txt
!                ccmd   <- newEventHandler
!                return (Check hcheck hwnd ccmd)
         set c props
         return c
--- 314,318 ----
    = do c <- do hwnd   <- get w windowHandle
                 hcheck <- Port.createCheckBox hwnd txt
!                return (Check hcheck hwnd)
         set c props
         return c
***************
*** 331,335 ****
     
  instance Commanding Check where
!   command = newCheckClickEvent chandle ccommand
  
  instance Control Check where
--- 326,330 ----
     
  instance Commanding Check where
!   command = newControlCommandEvent chandle
  
  instance Control Check where
***************
*** 340,346 ****
  --------------------------------------------------------------------}
  -- | A single radio control.
! data Radio    = Radio{ rhandle :: WindowHandle
!                      , rparent :: WindowHandle
!                      , rcommand :: EventHandler (IO ())
                       }
  
--- 335,340 ----
  --------------------------------------------------------------------}
  -- | A single radio control.
! data Radio    = Radio{ rhandle :: !WindowHandle
!                      , rparent :: !WindowHandle
                       }
  
***************
*** 356,361 ****
    = do r <- do hwnd   <- get w windowHandle
                 hradio <- Port.createRadioBox hwnd first txt
!                rcmd   <- newEventHandler
!                return (Radio hradio hwnd rcmd)
         set r props
         return r
--- 350,354 ----
    = do r <- do hwnd   <- get w windowHandle
                 hradio <- Port.createRadioBox hwnd first txt
!                return (Radio hradio hwnd)
         set r props
         return r
***************
*** 367,371 ****
     
  instance Commanding Radio where
!   command = newRadioClickEvent rhandle rcommand
  
  instance Control Radio where
--- 360,364 ----
     
  instance Commanding Radio where
!   command = newControlCommandEvent rhandle
  
  instance Control Radio where

Index: Events.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Events.hs,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** Events.hs	31 Jan 2003 21:06:40 -0000	1.4
--- Events.hs	25 Mar 2003 23:37:02 -0000	1.5
***************
*** 87,95 ****
              
               -- * Internal
-              -- ** Event handlers
-              , EventHandler
-              , newEventHandler
-              , hasEventHandler
-              
               -- ** Standard events
               -- *** Forms
--- 87,90 ----
***************
*** 104,114 ****
               , newKeyboardEvent
               -- *** Controls
!              , newButtonClickEvent
!              , newPopupClickEvent
!              , newRadioClickEvent
!              , newCheckClickEvent
  
               -- *** Paint
-              , PaintFunctionWrapper
               , newPaintEvent
               -- *** Misc
--- 99,105 ----
               , newKeyboardEvent
               -- *** Controls
!              , newControlCommandEvent
  
               -- *** Paint
               , newPaintEvent
               -- *** Misc
***************
*** 117,125 ****
               -- ** Generic event creators
               , newEvent
!              , StdEvent, StdWindowEvent
!              , stdWindowEvent0
!              , stdWindowEvent1
               , stdWindowEvent
-              , stdEvent
               ) where
  
--- 108,113 ----
               -- ** Generic event creators
               , newEvent
!              , StdWindowEvent
               , stdWindowEvent
               ) where
  
***************
*** 134,148 ****
  --------------------------------------------------------------------}
  -- | An event for a widget @w@ that expects an event handler of type @a@.
! data Event w a  = Event (Attr w a)
  
  -- | Get the event handler attribute for a certain event.
  on :: Event w a -> Attr w a
! on (Event attr)
    = attr
  
  -- | Change the event type.
  mapEvent :: (a -> b) -> (a -> b -> a) -> Event w a -> Event w b
! mapEvent get set (Event attr)
!   = Event (mapAttr get set attr)
  
  {--------------------------------------------------------------------
--- 122,140 ----
  --------------------------------------------------------------------}
  -- | An event for a widget @w@ that expects an event handler of type @a@.
! data Event w a  = Event (Attr w a) (Prop w)
  
  -- | Get the event handler attribute for a certain event.
  on :: Event w a -> Attr w a
! on (Event attr off)
    = attr
  
+ off :: Event w a -> Prop w
+ off (Event attr off)
+   = off
+ 
  -- | Change the event type.
  mapEvent :: (a -> b) -> (a -> b -> a) -> Event w a -> Event w b
! mapEvent get set (Event attr off)
!   = Event (mapAttr get set attr) off
  
  {--------------------------------------------------------------------
***************
*** 322,344 ****
             prev keyboardEvent
  
- 
- 
- {--------------------------------------------------------------------
-    A standard event handler for widget implementations
- --------------------------------------------------------------------}
- -- | A standard event handler.
- type EventHandler a   = Var (Maybe a)
- 
- -- | Create a fresh event handler
- newEventHandler :: IO (EventHandler a)
- newEventHandler 
-   = newVar Nothing
- 
- -- | Returns 'True' if there is a registered event handler.
- hasEventHandler :: EventHandler a -> IO Bool
- hasEventHandler eh
-   = do mbhandler <- getVar eh
-        return (isJust mbhandler)
- 
  {--------------------------------------------------------------------
     Standard event creations
--- 314,317 ----
***************
*** 346,400 ****
  -- Forms
  newDismissEvent, newActivateEvent, newDeactivateEvent :: StdWindowEvent w (IO ())
! newDismissEvent   = stdWindowEvent0 Lib.registerWindowDismiss
! newActivateEvent  = stdWindowEvent0 Lib.registerWindowActivate
! newDeactivateEvent= stdWindowEvent0 Lib.registerWindowDeactivate
  
  newResizeEvent    :: StdWindowEvent w (Size -> IO ())
! newResizeEvent    = stdWindowEvent1 Lib.registerWindowResize
  
  newScrollEvent    :: StdWindowEvent w (Point -> IO ())
! newScrollEvent    = stdWindowEvent1 Lib.registerWindowScroll
  
  -- Reactive
  newClosingEvent   :: StdWindowEvent w (IO ())
! newClosingEvent   = stdWindowEvent0 Lib.registerWindowDestroy
  
  newMouseEvent     :: StdWindowEvent w (MouseEvent -> IO ())
! newMouseEvent     = stdWindowEvent1 Lib.registerWindowMouse
  
  newKeyboardEvent  :: StdWindowEvent w (KeyboardEvent -> IO ())
! newKeyboardEvent  = stdWindowEvent1 Lib.registerWindowKeyboard
  
  -- commands
! newButtonClickEvent :: StdWindowEvent w (IO ())
! newButtonClickEvent = stdWindowEvent0 Lib.registerButtonClick
! 
! newPopupClickEvent :: StdWindowEvent w (IO ())
! newPopupClickEvent = stdWindowEvent0 Lib.registerPopUpClick
! 
! newRadioClickEvent :: StdWindowEvent w (IO ())
! newRadioClickEvent = stdWindowEvent0 Lib.registerRadioBoxClick
! 
! newCheckClickEvent :: StdWindowEvent w (IO ())
! newCheckClickEvent = stdWindowEvent0 Lib.registerCheckBoxClick
  
  {--------------------------------------------------------------------
     Special event creators
  --------------------------------------------------------------------}
- type PaintFunctionWrapper w = w -> PaintFunction -> CanvasHandle -> Rect -> IO ()
  
  -- | Create a paint event.
! newPaintEvent ::  PaintFunctionWrapper w -- ^ convert from paint function
!                 -> StdWindowEvent w PaintFunction            
! newPaintEvent convert getWindowHandle getEventVar 
!   = stdEvent (\_ _ _ -> return ())
!              (\w fun -> Lib.registerWindowPaint (getWindowHandle w) (convert w fun))
!              getEventVar
!  
  
  -- | Create a new generic event for menu command.
! newMenuEvent :: (w -> MenuHandle) -> (w -> EventHandler (IO ())) -> Event w (IO ())
! newMenuEvent getMenuHandle getEventVar 
!   = stdEvent (return ()) (\m io -> Lib.registerMenuCommand (getMenuHandle m) io) getEventVar
  
  
--- 319,361 ----
  -- Forms
  newDismissEvent, newActivateEvent, newDeactivateEvent :: StdWindowEvent w (IO ())
! newDismissEvent   = stdWindowEvent Lib.getWindowDismissHandler    Lib.setWindowDismissHandler    Lib.setWindowDismissDefHandler
! newActivateEvent  = stdWindowEvent Lib.getWindowActivateHandler   Lib.setWindowActivateHandler   Lib.setWindowActivateDefHandler
! newDeactivateEvent= stdWindowEvent Lib.getWindowDeactivateHandler Lib.setWindowDeactivateHandler Lib.setWindowDeactivateDefHandler
  
  newResizeEvent    :: StdWindowEvent w (Size -> IO ())
! newResizeEvent    = stdWindowEvent Lib.getWindowResizeHandler     Lib.setWindowResizeHandler     Lib.setWindowResizeDefHandler
  
  newScrollEvent    :: StdWindowEvent w (Point -> IO ())
! newScrollEvent    = stdWindowEvent Lib.getWindowScrollHandler     Lib.setWindowScrollHandler     Lib.setWindowScrollDefHandler
  
  -- Reactive
  newClosingEvent   :: StdWindowEvent w (IO ())
! newClosingEvent   = stdWindowEvent Lib.getWindowDestroyHandler    Lib.setWindowDestroyHandler    Lib.setWindowDestroyDefHandler
  
  newMouseEvent     :: StdWindowEvent w (MouseEvent -> IO ())
! newMouseEvent     = stdWindowEvent Lib.getWindowMouseHandler      Lib.setWindowMouseHandler      Lib.setWindowMouseDefHandler
  
  newKeyboardEvent  :: StdWindowEvent w (KeyboardEvent -> IO ())
! newKeyboardEvent  = stdWindowEvent Lib.getWindowKeyboardHandler   Lib.setWindowKeyboardHandler   Lib.setWindowKeyboardDefHandler
  
  -- commands
! newControlCommandEvent :: StdWindowEvent w (IO ())
! newControlCommandEvent = stdWindowEvent Lib.getControlCommandHandler Lib.setControlCommandHandler Lib.setControlCommandDefHandler
  
  {--------------------------------------------------------------------
     Special event creators
  --------------------------------------------------------------------}
  
  -- | Create a paint event.
! newPaintEvent ::  (w -> Var PaintFunction) -> (w -> PaintFunction -> CanvasHandle -> Rect -> IO ()) -> StdWindowEvent w PaintFunction
! newPaintEvent getv convert getWindowHandle
!   = newEvent (getVar . getv)
!              (\w h -> Lib.setWindowPaintHandler (getWindowHandle w) (convert w h) >> setVar (getv w) h)
!              (\w -> Lib.setWindowPaintDefHandler (getWindowHandle w) >> setVar (getv w) (\_ _ _ -> return ()))
  
  -- | Create a new generic event for menu command.
! newMenuEvent :: (w -> MenuHandle) -> Event w (IO ())
! newMenuEvent getMenuHandle
!   = newEvent (Lib.getMenuCommandHandler . getMenuHandle) (Lib.setMenuCommandHandler . getMenuHandle) (Lib.setMenuCommandDefHandler . getMenuHandle)
  
  
***************
*** 402,441 ****
     Generic event creators
  --------------------------------------------------------------------}
- -- | A standard event creation function.
- type StdEvent w a       = (w -> EventHandler a) -> Event w a
  
  -- | A standard event creation function for window handles.
! type StdWindowEvent w a = (w -> WindowHandle) -> StdEvent w a
! 
! 
! stdWindowEvent1 :: (WindowHandle -> (a -> IO ()) -> IO ()) -> StdWindowEvent w (a -> IO ())
! stdWindowEvent1 
!   = stdWindowEvent (\x -> return ())
! 
! stdWindowEvent0 :: (WindowHandle -> IO () -> IO ()) -> StdWindowEvent w (IO ())
! stdWindowEvent0 
!   = stdWindowEvent (return ())
! 
! stdWindowEvent :: a -> (WindowHandle -> a -> IO ()) -> StdWindowEvent w a
! stdWindowEvent defio register getHandle getEventVar
!   = stdEvent defio (\w io -> register (getHandle w) io) getEventVar
  
! stdEvent :: a -> (w -> a -> IO ()) -> StdEvent w a
! stdEvent defio register getEventVar 
!   = newEvent getter setter
!   where
!     getter w  
!       = do mbio <- getVar (getEventVar w)
!            case mbio of
!              Nothing -> return defio
!              Just io -> return io
!           
!     setter w io 
!       = do register w io
!            setVar (getEventVar w) (Just io)
!       
  
  -- | Create a new event from a get and set function.
! newEvent :: (w -> IO a) -> (w -> a -> IO ()) -> Event w a
! newEvent getter setter
!   = Event (newAttr getter setter)
\ No newline at end of file
--- 363,376 ----
     Generic event creators
  --------------------------------------------------------------------}
  
  -- | A standard event creation function for window handles.
! type StdWindowEvent w a = (w -> WindowHandle) -> Event w a
  
! stdWindowEvent :: (WindowHandle -> IO a) -> (WindowHandle -> a -> IO ()) -> (WindowHandle -> IO ()) -> StdWindowEvent w a
! stdWindowEvent getHandler setHandler setDefHandler getHandle
!   = newEvent (getHandler . getHandle) (setHandler . getHandle) (setDefHandler . getHandle)
  
  -- | Create a new event from a get and set function.
! newEvent :: (w -> IO a) -> (w -> a -> IO ()) -> (w -> IO ()) -> Event w a
! newEvent getter setter setdef
!   = Event (newAttr getter setter) (newProp setdef getter setter)

Index: Menu.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Menu.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Menu.hs	31 Jan 2003 01:01:44 -0000	1.2
--- Menu.hs	25 Mar 2003 23:37:03 -0000	1.3
***************
*** 78,82 ****
                              , vkey     :: Var Key
                              , venabled :: Var Bool
-                             , vcommand :: EventHandler (IO ())
                              }
  
--- 78,81 ----
***************
*** 87,93 ****
                     Lib.registerWindowMenu (hwindow menu) hitem
                     venabled <- newVar True
-                    vcommand <- newEventHandler
                     vkey     <- newVar Lib.KeyNull
!                    return (MenuItem hitem menu title vkey venabled vcommand)
         set mitem props
         return mitem
--- 86,91 ----
                     Lib.registerWindowMenu (hwindow menu) hitem
                     venabled <- newVar True
                     vkey     <- newVar Lib.KeyNull
!                    return (MenuItem hitem menu title vkey venabled)
         set mitem props
         return mitem
***************
*** 101,105 ****
  
  instance Commanding MenuItem where
!   command   = newMenuEvent hitem vcommand
  
  
--- 99,103 ----
  
  instance Commanding MenuItem where
!   command   = newMenuEvent hitem
  
  

Index: Timer.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Timer.hs,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -d -r1.1.1.1 -r1.2
*** Timer.hs	26 Jan 2003 12:41:50 -0000	1.1.1.1
--- Timer.hs	25 Mar 2003 23:37:03 -0000	1.2
***************
*** 88,92 ****
  instance Commanding Timer where
    command  
!     = newEvent getter setter
      where
        getter t
--- 88,92 ----
  instance Commanding Timer where
    command  
!     = newEvent getter setter setdef
      where
        getter t
***************
*** 99,102 ****
--- 99,109 ----
          = do setVar (vcommand t) (Just cmd)
               updateTimer t
+              
+       setdef t 
+         = do mbtimer <- takeVar (vtimer t)
+              case mbtimer of
+                Nothing -> return ()
+                Just h  -> Lib.destroyTimer h
+              putVar (vtimer t) Nothing
  
  {--------------------------------------------------------------------

Index: Window.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Window.hs,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** Window.hs	31 Jan 2003 20:54:08 -0000	1.5
--- Window.hs	25 Mar 2003 23:37:03 -0000	1.6
***************
*** 37,54 ****
                       , vbgcolor     :: Var Color
                       , vhatch       :: Var HatchStyle
!                      -- reactive
!                      , vclosing :: EventHandler (IO ())
!                      , vmouse   :: EventHandler (MouseEvent -> IO ())
!                      , vkeyboard:: EventHandler (KeyboardEvent -> IO ())
!                      -- form
!                      , vdismiss :: EventHandler (IO ())
!                      , vactivate:: EventHandler (IO ())
!                      , vdeactive:: EventHandler (IO ())
!                      , vscroll  :: EventHandler (Point -> IO ())
!                      , vresize  :: EventHandler (Size -> IO ())
!                      -- paint
!                      , vpaint   :: EventHandler PaintFunction
!                      -- layout
!                      , vrelayout:: EventHandler (IO ())
                       , vlayout  :: Var Layout
                       }
--- 37,41 ----
                       , vbgcolor     :: Var Color
                       , vhatch       :: Var HatchStyle
!                      , vpaint   :: Var PaintFunction
                       , vlayout  :: Var Layout
                       }
***************
*** 86,99 ****
  form :: WindowHandle -> WindowHandle -> [Prop Window] -> IO Window
  form hwindow hparent props
!   = do w <- do vclosing  <- newEventHandler
!                vmouse    <- newEventHandler
!                vkeyboard <- newEventHandler
!                vdismiss  <- newEventHandler
!                vactivate <- newEventHandler
!                vdeactive <- newEventHandler
!                vscroll   <- newEventHandler
!                vresize   <- newEventHandler
!                vpaint    <- newEventHandler
!                vrelayout <- newEventHandler
                 vautosize <- newVar True
                 vlayout   <- newVar empty
--- 73,77 ----
  form :: WindowHandle -> WindowHandle -> [Prop Window] -> IO Window
  form hwindow hparent props
!   = do w <- do vpaint    <- newVar (\_ _ _ -> return ())
                 vautosize <- newVar True
                 vlayout   <- newVar empty
***************
*** 101,116 ****
                 vresizeable   <- newVar True
                 vcolor    <- newVar black
!                vbgcolor  <- newVar dialoggrey
                 vhatch    <- newVar HatchSolid
                 return (Window hwindow hparent vdomain vresizeable vautosize 
!                               vcolor vbgcolor vhatch
!                               vclosing vmouse vkeyboard
!                               vdismiss vactivate vdeactive vscroll vresize
!                               vpaint vrelayout vlayout
                        )
         recolorWindow w
-        set w [domain =: sz 0 0]
-        set w [on dismiss =: close w]
-        set w [on keyboard =: keyboardWindow w]
         set w [on relayout =: relayoutWindow w]
         -- just by setting a dummy paint function, we will at least intialize the canvas properly on a repaint
--- 79,89 ----
                 vresizeable   <- newVar True
                 vcolor    <- newVar black
!                vbgcolor  <- newVar dialoggray
                 vhatch    <- newVar HatchSolid
                 return (Window hwindow hparent vdomain vresizeable vautosize 
!                               vcolor vbgcolor vhatch                              
!                               vpaint vlayout
                        )
         recolorWindow w
         set w [on relayout =: relayoutWindow w]
         -- just by setting a dummy paint function, we will at least intialize the canvas properly on a repaint
***************
*** 118,127 ****
         return w
  
-                     
- keyboardWindow w (KeyDown (KeyF4 mod) rep) | altDown mod
-   = close w
- keyboardWindow w kbd
-   = return ()
- 
  relayoutWindow :: Window -> IO ()
  relayoutWindow w
--- 91,94 ----
***************
*** 185,189 ****
  
  instance Widget Window where
!   close w    = Lib.closeWindow (hwindow w)
  
  instance Dimensions Window where
--- 152,157 ----
  
  instance Widget Window where
!   dismissWidget w    = Lib.dismissWindow (hwindow w)
!   destroyWidget w    = Lib.destroyWindow (hwindow w)
  
  instance Dimensions Window where
***************
*** 205,222 ****
  
  instance Reactive Window where
!   closing   = newClosingEvent hwindow vclosing
!   mouse     = newMouseEvent   hwindow vmouse 
!   keyboard  = newKeyboardEvent hwindow vkeyboard
  
  instance Form Window where  
!   dismiss   = newDismissEvent hwindow vdismiss
!   activate  = newActivateEvent hwindow vactivate
!   deactivate= newDeactivateEvent hwindow vdeactive
!   scroll    = newScrollEvent hwindow vscroll
!   resize    = newResizeEvent hwindow vresize
  
  instance Paint Window where
    repaint w = do Lib.invalidateWindow (hwindow w) 
!   paint     = newPaintEvent wndpaint hwindow vpaint 
              where
                wndpaint w paintfun hcanvas updArea
--- 173,190 ----
  
  instance Reactive Window where
!   closing   = newClosingEvent hwindow
!   mouse     = newMouseEvent   hwindow
!   keyboard  = newKeyboardEvent hwindow
  
  instance Form Window where  
!   dismiss   = newDismissEvent hwindow
!   activate  = newActivateEvent hwindow
!   deactivate= newDeactivateEvent hwindow
!   scroll    = newScrollEvent hwindow
!   resize    = newResizeEvent hwindow
  
  instance Paint Window where
    repaint w = do Lib.invalidateWindow (hwindow w) 
!   paint     = newPaintEvent vpaint wndpaint hwindow
              where
                wndpaint w paintfun hcanvas updArea
***************
*** 233,237 ****
  relayout :: Event Window (IO ())
  relayout
!   = stdWindowEvent0 Lib.registerWindowReLayout hwindow vrelayout
  
  
--- 201,205 ----
  relayout :: Event Window (IO ())
  relayout
!   = stdWindowEvent Lib.getWindowReLayoutHandler Lib.setWindowReLayoutHandler Lib.setWindowReLayoutDefHandler hwindow
  
  

[htoolkit-cvs] gio/src/Graphics/UI/GIO Attributes.hs,1.4,1.5

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

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

Modified Files:
	Attributes.hs 
Log Message:
Added newProp function which likely newAttr creates Prop value (instead of Attr). The 'close' operation on widgets are renamed to dismissWidget. Added destroyWidget operation.


Index: Attributes.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Attributes.hs,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** Attributes.hs	30 Jan 2003 23:58:27 -0000	1.4
--- Attributes.hs	25 Mar 2003 23:35:07 -0000	1.5
***************
*** 45,49 ****
               -- ** Widget 
               , Widget
!              , close
              
               -- ** Dimensions
--- 45,50 ----
               -- ** Widget 
               , Widget
!              , dismissWidget
!              , destroyWidget
              
               -- ** Dimensions
***************
*** 76,79 ****
--- 77,81 ----
               , mapAttr
               , newAttr
+              , newProp
               , varAttr
               , readAttr
***************
*** 97,100 ****
--- 99,106 ----
    = Attr getter setter
  
+ newProp :: (w -> IO ()) -> (w -> IO a) -> (w -> a -> IO ()) -> Prop w
+ newProp action getter setter
+   = Prop action (\w -> do oldx <- getter w; return (setter w oldx))
+ 
  -- | A property of a widget @w@ is an attribute that
  -- is already associated with a value. Properties are
***************
*** 164,200 ****
  -- | Associate an attribute with a new value into a property.
  (=:) :: Attr w a -> a -> Prop w
! (=:) (Attr getter setter) x
!   = Prop (\w -> setter w x) 
!          (\w -> do oldx <- getter w; return (setter w oldx))
            
  -- | Apply an update function to an attribute.
  (~:) :: Attr w a -> (a -> a) -> Prop w
! (~:) (Attr getter setter) f
!   = Prop (\w -> do x <- getter w; setter w (f x))
!          (\w -> do oldx <- getter w; return (setter w oldx))
  
  -- | Set the value of an attribute with a function that takes the widget
  -- itself as an argument.
  (=::) :: Attr w a -> (w -> a) -> Prop w
! (=::) (Attr getter setter) f
!   = Prop (\w -> setter w (f w))
!          (\w -> do oldx <- getter w; return (setter w oldx))
            
  -- | Set the value of an attribute with a function that takes the widget
  -- itself and the current value of the attribute as arguments. 
  (~::) :: Attr w a -> (w -> a -> a) -> Prop w
! (~::) (Attr getter setter) f
!   = Prop (\w -> do x <- getter w; setter w (f w x))
!          (\w -> do oldx <- getter w; return (setter w oldx))
! 
  
  {--------------------------------------------------------------------
    Classes
  --------------------------------------------------------------------}
! -- | Every window item is part of the 'Widget' class. The only operation
! -- on widgets is 'close'.
  class Widget w where
    -- | Close a widget
!   close :: w -> IO ()
    
  -- | Widgets with dimensions have a width, height and position. Only the
--- 170,198 ----
  -- | Associate an attribute with a new value into a property.
  (=:) :: Attr w a -> a -> Prop w
! (=:) (Attr getter setter) x = newProp (\w -> setter w x) getter setter
            
  -- | Apply an update function to an attribute.
  (~:) :: Attr w a -> (a -> a) -> Prop w
! (~:) (Attr getter setter) f = newProp (\w -> do x <- getter w; setter w (f x)) getter setter
  
  -- | Set the value of an attribute with a function that takes the widget
  -- itself as an argument.
  (=::) :: Attr w a -> (w -> a) -> Prop w
! (=::) (Attr getter setter) f = newProp (\w -> setter w (f w)) getter setter
            
  -- | Set the value of an attribute with a function that takes the widget
  -- itself and the current value of the attribute as arguments. 
  (~::) :: Attr w a -> (w -> a -> a) -> Prop w
! (~::) (Attr getter setter) f = newProp (\w -> do x <- getter w; setter w (f w x)) getter setter
  
  {--------------------------------------------------------------------
    Classes
  --------------------------------------------------------------------}
! -- | Every window item is part of the 'Widget' class. The operations
! -- on widgets are 'dismissWidget' and 'destroyWidget'.
  class Widget w where
    -- | Close a widget
!   dismissWidget :: w -> IO Bool
!   destroyWidget :: w -> IO ()
    
  -- | Widgets with dimensions have a width, height and position. Only the