htoolkit-cvs

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

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

Modified Files:
	Attributes.hs Events.hs Menu.hs 
Log Message:
Complete implementation for Menu with both GTK and Win32.
Supported:
   - command menu items with bitmaps
   - checked menu items
   - radio menu items
   - sepparators
   - sub menus



Index: Attributes.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Attributes.hs,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** Attributes.hs	30 Mar 2003 18:49:07 -0000	1.8
--- Attributes.hs	23 Apr 2003 21:48:46 -0000	1.9
***************
*** 69,72 ****
--- 69,78 ----
               -- ** ToolTip
               , ToolTip, tooltip
+              
+              -- ** Accelerated
+              , Accelerated, accel            
+                
+              -- ** Positioned
+              , Positioned, pos
  
               -- ** Selection
***************
*** 263,266 ****
--- 269,282 ----
    -- | The tip text
    tooltip :: Attr w String
+ 
+ -- | Widgets that has accelerator key.
+ class Accelerated w where
+   -- | The accelerator. Set the property to (@KeyNull@) to remove the accelerator key.
+   accel :: Attr w Key
+   
+ -- | Widgets that has specified integer position.
+ class Positioned w where
+   -- | The widget position
+   pos :: Attr w Int
  
  -- | Widgets that can be checked.

Index: Events.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Events.hs,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** Events.hs	14 Apr 2003 20:40:37 -0000	1.11
--- Events.hs	23 Apr 2003 21:48:47 -0000	1.12
***************
*** 66,69 ****
--- 66,72 ----
               , Commanding, command
               
+              -- ** Dynamic update
+              , DynamicUpdate, update
+              
               -- ** Reactive
               , Reactive
***************
*** 117,122 ****
               -- *** Paint
               , newPaintEvent
-              -- *** Misc
-              , newMenuEvent
  
               -- ** Generic event creators
--- 120,123 ----
***************
*** 159,162 ****
--- 160,168 ----
  class Commanding w where
    command :: Event w (IO ())
+   
+ -- | The widgets which are members of 'DynamicUpdate' class has 'update'
+ -- event. The 'update' event is raised when the widget can update its state.
+ class DynamicUpdate w where
+   update :: Event w (IO ())
  
  -- | A form is a visible window on the screen.
***************
*** 386,394 ****
               (\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)
  
  {--------------------------------------------------------------------
--- 392,395 ----

Index: Menu.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Menu.hs,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** Menu.hs	1 Apr 2003 23:54:20 -0000	1.5
--- Menu.hs	23 Apr 2003 21:48:47 -0000	1.6
***************
*** 1,8 ****
  -----------------------------------------------------------------------------------------
  {-| Module      :  Menu
!     Copyright   :  (c) Daan Leijen 2003
      License     :  BSD-style
  
!     Maintainer  :  da...@cs...
      Stability   :  provisional
      Portability :  portable
--- 1,8 ----
  -----------------------------------------------------------------------------------------
  {-| Module      :  Menu
!     Copyright   :  (c) Krasimir Angelov & Daan Leijen 2003
      License     :  BSD-style
  
!     Maintainer  :  ka2...@ya... da...@cs...
      Stability   :  provisional
      Portability :  portable
***************
*** 13,25 ****
  module Graphics.UI.GIO.Menu
              ( -- * Menus
!               Menu, mainMenu, menu
                -- * Menu items
                -- ** Menu item
!             , MenuItem, menuitem, menukey
                -- ** Menu separator
!             , menuline
              ) where
  
! import Char (isLower, isUpper)
  import qualified Graphics.UI.Port as Lib
  import Graphics.UI.GIO.Types
--- 13,31 ----
  module Graphics.UI.GIO.Menu
              ( -- * Menus
!               Menu, mainMenu, menu, menuAt, itemCount
                -- * Menu items
                -- ** Menu item
!             , MenuItem, menuitem, menuitemAt
!             , menuicon
! 	      -- ** Checked menu items
!             , MenuCheck, menucheck, menucheckAt
!               -- ** Radio group and radio items
!             , MenuRadioGroup, menuRadioGroupAt, menuRadioGroup 
!             , MenuRadioItem, menuRadioItemAt, menuRadioItem
                -- ** Menu separator
!             , MenuLine, menuline, menulineAt
              ) where
  
! import System.IO.Unsafe( unsafePerformIO )
  import qualified Graphics.UI.Port as Lib
  import Graphics.UI.GIO.Types
***************
*** 34,104 ****
  -- | A menu is a widget that contains menu items or other (sub) menus.
  -- The top level menu is always a 'mainMenu'. 
! data Menu         = Menu{ hmenu   :: !MenuHandle
!                         }
  -- | The main application menu
  mainMenu :: Menu
  mainMenu = Menu Lib.mainMenu
  
! -- | Add a menu.
! menu :: String -> [Prop Menu] -> Menu -> IO Menu
! menu title props parent
!   = do m     <- do hmenu <- Lib.addMenu (hmenu parent) title
                     return (Menu hmenu)
         set m props
         return m
  
! {--------------------------------------------------------------------
!   Menu items
! --------------------------------------------------------------------}
  -- | Menu items are labeled entries in a menu.
! data MenuItem     = MenuItem{ hitem    :: MenuHandle
!                             , parent   :: Menu
!                             , mtext    :: String
!                             , vkey     :: Var Key
!                             }
  
! -- | Create a menu item with a certain label.
! menuitem :: String -> [Prop MenuItem] -> Menu -> IO MenuItem
! menuitem title props menu
!   = do mitem <- do hitem    <- Lib.addMenuItem (hmenu menu) Lib.KeyNull title
!                    vkey     <- newVar Lib.KeyNull
!                    return (MenuItem hitem menu title vkey)
         set mitem props
         return mitem
  
! 
  
  instance Able MenuItem where
!   enabled   = newAttr (\w -> Lib.getMenuItemEnabled (hmenu (parent w)) (hitem w))
!                       (\w -> Lib.setMenuItemEnabled (hmenu (parent w)) (hitem w))
  
  instance Commanding MenuItem where
!   command   = newMenuEvent hitem
  
  
! -- | The menu short-cut key. Use (@KeyChar '\0'@) for no short-cut key (default)
! menukey :: Attr MenuItem Key
! menukey 
!   = newAttr (\w   -> getVar (vkey w))
!             (\w x -> do setVar (vkey w) x; menuItemUpdateLabel w)
  
! menuItemUpdateLabel m
!   = do key <- getVar (vkey m)
!        Lib.setMenuItemLabel (hmenu (parent m)) (hitem m) key (mtext m)
  
! {--------------------------------------------------------------------
!   Menu separator
! --------------------------------------------------------------------}
! -- | Adds a menu seperator line
! menuline :: Menu -> IO ()
! menuline menu
!   = Lib.addMenuSeparatorItem (hmenu menu)
  
! {--------------------------------------------------------------------
!   do m  <- menubar [] w
!      fm <- submenu "&File" [] m
!      menuitem "&Open"  [] fm
!      menuitem "&Close" [] fm
!      menuitem "E&xit"  [] fm
!      
! --------------------------------------------------------------------}
--- 40,253 ----
  -- | A menu is a widget that contains menu items or other (sub) menus.
  -- The top level menu is always a 'mainMenu'. 
! newtype Menu = Menu MenuHandle
! hmenu (Menu h) = h
! 
  -- | The main application menu
  mainMenu :: Menu
  mainMenu = Menu Lib.mainMenu
  
! -- | Insert a menu at specified position.
! menuAt :: Maybe Int -> [Prop Menu] -> Menu -> IO Menu
! menuAt pos props parent
!   = do m     <- do hmenu <- Lib.insertMenu (hmenu parent) pos
                     return (Menu hmenu)
         set m props
         return m
  
! -- | Append a menu
! menu :: [Prop Menu] -> Menu -> IO Menu
! menu = menuAt Nothing
!        
! instance Titled Menu where
!   title = newAttr (Lib.getMenuLabel . hmenu) (Lib.setMenuLabel . hmenu)
!   
! itemCount :: Attr Menu Int
! itemCount = readAttr "itemsCount" (Lib.getMenuItemCount . hmenu)
! 
! instance Positioned Menu where
!   pos = readAttr "pos" (Lib.getMenuItemPos . hmenu)
!   
! instance Deadly Menu where
!   destroyWidget m = Lib.destroyMenu (hmenu m)
!   destroy         = newEvent (Lib.getMenuDestroyHandler . hmenu) (Lib.setMenuDestroyHandler . hmenu) (Lib.setMenuDestroyDefHandler . hmenu)
! 
! --------------------------------------------------------------------
! --  Menu items
! --------------------------------------------------------------------
  -- | Menu items are labeled entries in a menu.
! newtype MenuItem = MenuItem MenuHandle
! hitem (MenuItem h) = h
  
! -- | Create a menu item and insert it at specified position.
! menuitemAt :: Maybe Int -> [Prop MenuItem] -> Menu -> IO MenuItem
! menuitemAt pos props menu
!   = do mitem <- do hitem   <- Lib.insertMenuItem (hmenu menu) pos
!                    return (MenuItem hitem)
         set mitem props
         return mitem
  
! -- | Create a menu item and appends it to parent menu.
! menuitem :: [Prop MenuItem] -> Menu -> IO MenuItem
! menuitem = menuitemAt Nothing 
  
  instance Able MenuItem where
!   enabled   = newAttr (Lib.getMenuItemEnabled . hitem) (Lib.setMenuItemEnabled . hitem)
  
  instance Commanding MenuItem where
!   command = newEvent (Lib.getMenuCommandHandler . hitem) (Lib.setMenuCommandHandler . hitem) (Lib.setMenuCommandDefHandler . hitem)
!     
! instance DynamicUpdate MenuItem where
!   update  = newEvent (Lib.getMenuUpdateHandler  . hitem) (Lib.setMenuUpdateHandler  . hitem) (Lib.setMenuUpdateDefHandler  . hitem)
  
+ instance Titled MenuItem where
+   title = newAttr (Lib.getMenuLabel . hitem) (Lib.setMenuLabel . hitem)
  
! instance Accelerated MenuItem where
!   accel = newAttr (Lib.getMenuItemAccel . hitem) (Lib.setMenuItemAccel . hitem)
  
! menuicon :: Attr MenuItem (Maybe Bitmap)
! menuicon = newAttr (Lib.getMenuItemBitmap . hitem) 
!                    (Lib.setMenuItemBitmap . hitem)
  
! instance Positioned MenuItem where
!   pos = readAttr "pos" (Lib.getMenuItemPos . hitem)
  
! instance Deadly MenuItem where
!   destroyWidget m = Lib.destroyMenu (hitem m)
!   destroy         = newEvent (Lib.getMenuDestroyHandler . hitem) (Lib.setMenuDestroyHandler . hitem) (Lib.setMenuDestroyDefHandler . hitem)
!   
! --------------------------------------------------------------------
! --  Menu radio groups and radio items
! --------------------------------------------------------------------
! -- | Menu items are labeled entries in a menu.
! newtype MenuRadioGroup = MenuRadioGroup MenuHandle
! hradiogroup (MenuRadioGroup h) = h
! 
! -- | Create a menu item and insert it at specified position.
! menuRadioGroupAt :: Maybe Int -> [Prop MenuRadioGroup] -> Menu -> IO MenuRadioGroup
! menuRadioGroupAt pos props menu
!   = do mradiogroup <- do hradiogroup   <- Lib.insertMenuRadioGroup (hmenu menu) pos
!                          return (MenuRadioGroup hradiogroup)
!        set mradiogroup props
!        return mradiogroup
! 
! -- | Create a menu item and appends it to parent menu.
! menuRadioGroup :: [Prop MenuRadioGroup] -> Menu -> IO MenuRadioGroup
! menuRadioGroup = menuRadioGroupAt Nothing 
! 
! instance Positioned MenuRadioGroup where
!   pos = readAttr "pos" (Lib.getMenuItemPos . hradiogroup)
! 
! instance Deadly MenuRadioGroup where
!   destroyWidget m = Lib.destroyMenu (hradiogroup m)
!   destroy         = newEvent (Lib.getMenuDestroyHandler . hradiogroup) (Lib.setMenuDestroyHandler . hradiogroup) (Lib.setMenuDestroyDefHandler . hradiogroup)
!   
! instance SingleSelect MenuRadioGroup where
!   selected  = newAttr (Lib.getMenuRadioGroupSelection . hradiogroup) (Lib.setMenuRadioGroupSelection . hradiogroup)
!   
! -- | Menu items are labeled entries in a menu.
! newtype MenuRadioItem = MenuRadioItem MenuHandle
! hradioitem (MenuRadioItem h) = h
! 
! -- | Create a menu item and insert it at specified position.
! menuRadioItemAt :: Maybe Int -> [Prop MenuRadioItem] -> MenuRadioGroup -> IO MenuRadioItem
! menuRadioItemAt pos props group
!   = do mradioitem <- do hradioitem   <- Lib.insertMenuRadioItem (hradiogroup group) pos
!                         return (MenuRadioItem hradioitem)
!        set mradioitem props
!        return mradioitem
! 
! -- | Create a menu item and appends it to parent menu.
! menuRadioItem :: [Prop MenuRadioItem] -> MenuRadioGroup -> IO MenuRadioItem
! menuRadioItem = menuRadioItemAt Nothing 
! 
! instance Able MenuRadioItem where
!   enabled   = newAttr (Lib.getMenuItemEnabled . hradioitem) (Lib.setMenuItemEnabled . hradioitem)
! 
! instance Commanding MenuRadioItem where
!   command = newEvent (Lib.getMenuCommandHandler . hradioitem) (Lib.setMenuCommandHandler . hradioitem) (Lib.setMenuCommandDefHandler . hradioitem)
!     
! instance DynamicUpdate MenuRadioItem where
!   update  = newEvent (Lib.getMenuUpdateHandler  . hradioitem) (Lib.setMenuUpdateHandler  . hradioitem) (Lib.setMenuUpdateDefHandler  . hradioitem)
! 
! instance Positioned MenuRadioItem where
!   pos = readAttr "pos" (Lib.getMenuItemPos . hradioitem)
! 
! instance Deadly MenuRadioItem where
!   destroyWidget m = Lib.destroyMenu (hradioitem m)
!   destroy         = newEvent (Lib.getMenuDestroyHandler . hradioitem) (Lib.setMenuDestroyHandler . hradioitem) (Lib.setMenuDestroyDefHandler . hradioitem)
!   
! instance Titled MenuRadioItem where
!   title = newAttr (Lib.getMenuLabel . hradioitem) (Lib.setMenuLabel . hradioitem)
! 
! instance Accelerated MenuRadioItem where
!   accel = newAttr (Lib.getMenuItemAccel . hradioitem) (Lib.setMenuItemAccel . hradioitem)
!   
! --------------------------------------------------------------------
! --  Checked menu items
! --------------------------------------------------------------------
! -- | Menu items are labeled entries in a menu.
! newtype MenuCheck = MenuCheck MenuHandle
! hcheck (MenuCheck h) = h
! 
! -- | Create a menu item and insert it at specified position.
! menucheckAt :: Maybe Int -> [Prop MenuCheck] -> Menu -> IO MenuCheck
! menucheckAt pos props menu
!   = do mcheck <- do mcheck <- Lib.insertMenuCheckItem (hmenu menu) pos
!                     return (MenuCheck mcheck)
!        set mcheck props
!        return mcheck
! 
! -- | Create a checked menu item and appends it to parent menu.
! menucheck :: [Prop MenuCheck] -> Menu -> IO MenuCheck
! menucheck = menucheckAt Nothing 
! 
! instance Able MenuCheck where
!   enabled   = newAttr (Lib.getMenuItemEnabled . hcheck) (Lib.setMenuItemEnabled . hcheck)
! 
! instance Commanding MenuCheck where
!   command = newEvent (Lib.getMenuCommandHandler . hcheck) (Lib.setMenuCommandHandler . hcheck) (Lib.setMenuCommandDefHandler . hcheck)
!     
! instance DynamicUpdate MenuCheck where
!   update  = newEvent (Lib.getMenuUpdateHandler  . hcheck) (Lib.setMenuUpdateHandler  . hcheck) (Lib.setMenuUpdateDefHandler  . hcheck)
!   
! instance Titled MenuCheck where
!   title = newAttr (Lib.getMenuLabel . hcheck) (Lib.setMenuLabel . hcheck)
! 
! instance Accelerated MenuCheck where
!   accel = newAttr (Lib.getMenuItemAccel . hcheck) (Lib.setMenuItemAccel . hcheck)
! 
! instance Positioned MenuCheck where
!   pos = readAttr "pos" (Lib.getMenuItemPos . hcheck)
!   
! instance Checked MenuCheck where
!   checked = newAttr (Lib.getMenuItemChecked . hcheck) (Lib.setMenuItemChecked . hcheck)
! 
! instance Deadly MenuCheck where
!   destroyWidget m = Lib.destroyMenu (hcheck m)
!   destroy         = newEvent (Lib.getMenuDestroyHandler . hcheck) (Lib.setMenuDestroyHandler . hcheck) (Lib.setMenuDestroyDefHandler . hcheck)
! 
! --------------------------------------------------------------------
! --  Menu separator
! --------------------------------------------------------------------
! 
! -- | Menu separator item
! newtype MenuLine = MenuLine MenuHandle
! hline (MenuLine h) = h
! 
! -- | Insert a menu seperator line at specified position.
! menulineAt :: Maybe Int -> Menu -> IO MenuLine
! menulineAt pos menu
!   = do hitem  <- Lib.insertMenuSeparatorItem (hmenu menu) pos
!        return (MenuLine hitem)
! 
! -- | Append a menu seperator line
! menuline :: Menu -> IO MenuLine
! menuline = menulineAt Nothing
! 
! instance Positioned MenuLine where
!   pos = readAttr "pos" (Lib.getMenuItemPos . hline)
! 
! instance Deadly MenuLine where
!   destroyWidget m = Lib.destroyMenu (hline m)
!   destroy         = newEvent (Lib.getMenuDestroyHandler . hline) (Lib.setMenuDestroyHandler . hline) (Lib.setMenuDestroyDefHandler . hline)