|
From: <kr_...@us...> - 2003-04-23 21:49:30
|
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)
|