Menu
▾
▴
[htoolkit-cvs] gio/src/Graphics/UI/GIO Action.hs,NONE,1.1 MenuType.hs,NONE,1.1 Attributes.hs,1.21,1.22 Events.hs,1.17,1.18 Menu.hs,1.17,1.18 ToolBar.hs,1.8,1.9 Types.hs,1.19,1.20
Update of /cvsroot/htoolkit/gio/src/Graphics/UI/GIO In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5356/gio/src/Graphics/UI/GIO Modified Files: Attributes.hs Events.hs Menu.hs ToolBar.hs Types.hs Added Files: Action.hs MenuType.hs Log Message: This is a major rewrite of menu and toolbar support. The main feature is that the new API provides action based menu and toolbar. The another advantage is that now the code is more simpler and shorter. The low lever API is implemented only under Linux for now. --- NEW FILE: Action.hs --- ----------------------------------------------------------------------------------------- {-| Module : Action Copyright : (c) Krasimir Angelov 2003 License : BSD-style Maintainer : ka2...@ya... Stability : provisional Portability : portable Actions represent operations that the user can be perform, along with some information how it should be presented in the interface. There are functions which allows to create menu and toolbar items from a given action. As well as the event that is fired when the action gets activated, the following also gets associated with the action: a label, an accelerator, a tooltip and a toolbar label (usually shorter than label). Apart from regular actions, there are check actions, which can be toggled between two states and radio actions, of which only one in a group can be in the 'selected' state. -} ----------------------------------------------------------------------------------------- module Graphics.UI.GIO.Action ( Action, action , CheckAction, checkAction , RadioAction, radioAction, setActionRadioGroup , DropDownAction, dropDownAction , IsAction, haction ) where import Graphics.UI.GIO.Attributes import Graphics.UI.GIO.Events import Graphics.UI.GIO.Types import Graphics.UI.GIO.MenuType import qualified Graphics.UI.Port as Lib class IsAction a where haction :: a -> ActionHandle -------------------------------------------------------------------- -- Action -------------------------------------------------------------------- newtype Action = Action ActionHandle action :: [Prop Action] -> IO Action action props = do act <- do haction <- Lib.createAction return (Action haction) set act props return act instance IsAction Action where haction (Action h) = h instance Able Action where enabled = newStdAttr haction Lib.getActionEnabled Lib.setActionEnabled instance Commanding Action where command = newStdEvent haction Lib.getActionCommandHandler Lib.setActionCommandHandler Lib.setActionCommandDefHandler instance DynamicUpdate Action where update = newStdEvent haction Lib.getActionUpdateHandler Lib.setActionUpdateHandler Lib.setActionUpdateDefHandler instance HasIcon Action where icon = newStdAttr haction Lib.getActionBitmap Lib.setActionBitmap instance Tipped Action where tooltip = newStdAttr haction Lib.getActionTip Lib.setActionTip instance Titled Action where title = newStdAttr haction Lib.getActionText Lib.setActionText shortTitle = newStdAttr haction Lib.getActionShortText Lib.setActionShortText instance Accelerated Action where accel = newStdAttr haction Lib.getActionAccel Lib.setActionAccel instance Deadly Action where destroyWidget t = Lib.destroyAction (haction t) destroy = newStdEvent haction Lib.getActionDestroyHandler Lib.setActionDestroyHandler Lib.setActionDestroyDefHandler -------------------------------------------------------------------- -- CheckAction -------------------------------------------------------------------- newtype CheckAction = CheckAction ActionHandle checkAction :: [Prop CheckAction] -> IO CheckAction checkAction props = do act <- do haction <- Lib.createCheckAction return (CheckAction haction) set act props return act instance IsAction CheckAction where haction (CheckAction h) = h instance Able CheckAction where enabled = newStdAttr haction Lib.getActionEnabled Lib.setActionEnabled instance Commanding CheckAction where command = newStdEvent haction Lib.getActionCommandHandler Lib.setActionCommandHandler Lib.setActionCommandDefHandler instance DynamicUpdate CheckAction where update = newStdEvent haction Lib.getActionUpdateHandler Lib.setActionUpdateHandler Lib.setActionUpdateDefHandler instance HasIcon CheckAction where icon = newStdAttr haction Lib.getActionBitmap Lib.setActionBitmap instance Tipped CheckAction where tooltip = newStdAttr haction Lib.getActionTip Lib.setActionTip instance Titled CheckAction where title = newStdAttr haction Lib.getActionText Lib.setActionText shortTitle = newStdAttr haction Lib.getActionShortText Lib.setActionShortText instance Checked CheckAction where checked = newStdAttr haction Lib.getActionChecked Lib.setActionChecked instance Accelerated CheckAction where accel = newStdAttr haction Lib.getActionAccel Lib.setActionAccel instance Deadly CheckAction where destroyWidget t = Lib.destroyAction (haction t) destroy = newStdEvent haction Lib.getActionDestroyHandler Lib.setActionDestroyHandler Lib.setActionDestroyDefHandler -------------------------------------------------------------------- -- RadioAction -------------------------------------------------------------------- newtype RadioAction = RadioAction ActionHandle radioAction :: [Prop RadioAction] -> IO RadioAction radioAction props = do act <- do haction <- Lib.createRadioAction return (RadioAction haction) set act props return act instance IsAction RadioAction where haction (RadioAction h) = h instance Able RadioAction where enabled = newStdAttr haction Lib.getActionEnabled Lib.setActionEnabled instance Commanding RadioAction where command = newStdEvent haction Lib.getActionCommandHandler Lib.setActionCommandHandler Lib.setActionCommandDefHandler instance DynamicUpdate RadioAction where update = newStdEvent haction Lib.getActionUpdateHandler Lib.setActionUpdateHandler Lib.setActionUpdateDefHandler instance HasIcon RadioAction where icon = newStdAttr haction Lib.getActionBitmap Lib.setActionBitmap instance Tipped RadioAction where tooltip = newStdAttr haction Lib.getActionTip Lib.setActionTip instance Titled RadioAction where title = newStdAttr haction Lib.getActionText Lib.setActionText shortTitle = newStdAttr haction Lib.getActionShortText Lib.setActionShortText instance Checked RadioAction where checked = newStdAttr haction Lib.getActionChecked Lib.setActionChecked instance Accelerated RadioAction where accel = newStdAttr haction Lib.getActionAccel Lib.setActionAccel instance Deadly RadioAction where destroyWidget t = Lib.destroyAction (haction t) destroy = newStdEvent haction Lib.getActionDestroyHandler Lib.setActionDestroyHandler Lib.setActionDestroyDefHandler setActionRadioGroup :: [RadioAction] -> IO () setActionRadioGroup acts = Lib.setActionRadioGroup (map haction acts) -------------------------------------------------------------------- -- DropDownAction -------------------------------------------------------------------- newtype DropDownAction = DropDownAction ActionHandle dropDownAction :: Menu -> [Prop DropDownAction] -> IO DropDownAction dropDownAction menu props = do act <- do haction <- Lib.createDropDownAction (hmenu menu) return (DropDownAction haction) set act props return act instance IsAction DropDownAction where haction (DropDownAction h) = h instance Able DropDownAction where enabled = newStdAttr haction Lib.getActionEnabled Lib.setActionEnabled instance DynamicUpdate DropDownAction where update = newStdEvent haction Lib.getActionUpdateHandler Lib.setActionUpdateHandler Lib.setActionUpdateDefHandler instance HasIcon DropDownAction where icon = newStdAttr haction Lib.getActionBitmap Lib.setActionBitmap instance Tipped DropDownAction where tooltip = newStdAttr haction Lib.getActionTip Lib.setActionTip instance Titled DropDownAction where title = newStdAttr haction Lib.getActionText Lib.setActionText instance Deadly DropDownAction where destroyWidget t = Lib.destroyAction (haction t) destroy = newStdEvent haction Lib.getActionDestroyHandler Lib.setActionDestroyHandler Lib.setActionDestroyDefHandler --- NEW FILE: MenuType.hs --- -- #hide module Graphics.UI.GIO.MenuType where import Graphics.UI.GIO.Types -- | A menu is a widget that contains menu items or other (sub) menus. -- The top level menu is always a 'mainMenu'. newtype Menu = Menu {hmenu :: MenuHandle} Index: Attributes.hs =================================================================== RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Attributes.hs,v retrieving revision 1.21 retrieving revision 1.22 diff -C2 -d -r1.21 -r1.22 *** Attributes.hs 23 Nov 2003 16:29:13 -0000 1.21 --- Attributes.hs 12 May 2004 20:42:32 -0000 1.22 *************** *** 37,56 **** ----------------------------------------------------------------------------------------- module Graphics.UI.GIO.Attributes ! ( -- * Attributes and properties Attr, Prop , set1, set, get, with, (=:), (~:), (=::), (~::) ! -- * Generic attribute creators - , mapAttr , newAttr , newStdAttr - , newProp , varAttr , readAttr , writeAttr ! -- * Common widget classes ! -- ** Dimensions , Dimensions --- 37,58 ---- ----------------------------------------------------------------------------------------- module Graphics.UI.GIO.Attributes ! ( -- * Attributes and properties Attr, Prop , set1, set, get, with, (=:), (~:), (=::), (~::) ! -- * Generic attribute creators , newAttr , newStdAttr , varAttr , readAttr , writeAttr ! , mapAttr ! , mapAttrObj ! , newProp ! , mapProp ! -- * Common widget classes ! -- ** Dimensions , Dimensions *************** *** 59,84 **** -- ** HasFont , HasFont, font ! -- ** Drawn , Drawn, bufferMode, pen , color, bgcolor, hatch ! , thickness, capstyle, linestyle, joinstyle , drawMode, bkDrawMode ! -- ** Titled ! , Titled, title -- ** Able , Able, enabled ! -- ** Tipped , Tipped, tooltip ! -- ** Accelerated ! , Accelerated, accel ! -- ** Positioned , Positioned, pos ! -- ** Visible , Visible, visible --- 61,86 ---- -- ** HasFont , HasFont, font ! -- ** Drawn , Drawn, bufferMode, pen , color, bgcolor, hatch ! , thickness, capstyle, linestyle, joinstyle , drawMode, bkDrawMode ! -- ** Titled ! , Titled, title, shortTitle -- ** Able , Able, enabled ! -- ** Tipped , Tipped, tooltip ! -- ** Accelerated ! , Accelerated, accel ! -- ** Positioned , Positioned, pos ! -- ** Visible , Visible, visible *************** *** 91,98 **** , MultiSelect, selection , RangedSelect, range, selectedPos ! -- ** Valued , Valued, value ! -- ** Icon , HasIcon, icon --- 93,100 ---- , MultiSelect, selection , RangedSelect, range, selectedPos ! -- ** Valued , Valued, value ! -- ** Icon , HasIcon, icon *************** *** 108,112 **** --------------------------------------------------------------------} -- | Widgets @w@ can have attributes of type @a@. ! data Attr w a = Attr (w -> IO a) (w -> a -> IO ()) -- | Create a new attribute with a specified getter and setter function. --- 110,114 ---- --------------------------------------------------------------------} -- | Widgets @w@ can have attributes of type @a@. ! data Attr w a = Attr !(w -> IO a) !(w -> a -> IO ()) -- | Create a new attribute with a specified getter and setter function. *************** *** 125,130 **** -- is already associated with a value. Properties are -- constructed with the '(=:)' operator. ! data Prop w = Prop{ propSet :: (w -> IO ()) ! , propRestore :: (w -> IO (IO ())) -- a function that returns a restoration function :-) } --- 127,132 ---- -- is already associated with a value. Properties are -- constructed with the '(=:)' operator. ! data Prop w = Prop{ propSet :: !(w -> IO ()) ! , propRestore :: !(w -> IO (IO ())) -- a function that returns a restoration function :-) } *************** *** 140,143 **** --- 142,153 ---- + -- | (@mapAttrObj f attr@) maps an attribute of @Attr w1 a@ to + -- @Attr w2 b@ where (@f :: w2 -> w1@). + mapAttrObj :: (w2 -> w1) -> Attr w1 a -> Attr w2 a + mapAttrObj f (Attr getter setter) = Attr (getter . f) (setter . f) + + mapProp :: (w2 -> w1) -> Prop w1 -> Prop w2 + mapProp f (Prop set restore) = Prop (set . f) (restore . f) + -- | Helper function to implement an attribute that just gets or sets a 'Var' member. varAttr :: (w -> Var a) -> Attr w a *************** *** 285,288 **** --- 295,303 ---- -- | The title. title :: Attr w String + -- | The short title. The @shortTitle@ attribute is used only in cases when + -- one and the same widget must have two titles: one short and one more desctiptive. + -- If the function is not overriden then the default value is a equal to 'title' + shortTitle :: Attr w String + shortTitle = title -- | Widgets that can be enabled or disabled. Index: Events.hs =================================================================== RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Events.hs,v retrieving revision 1.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** Events.hs 31 Aug 2003 11:48:26 -0000 1.17 --- Events.hs 12 May 2004 20:42:32 -0000 1.18 *************** *** 55,63 **** ----------------------------------------------------------------------------------------- module Graphics.UI.GIO.Events ! ( -- * Event Event , on, off , mapEvent -- * Basic events --- 55,64 ---- ----------------------------------------------------------------------------------------- module Graphics.UI.GIO.Events ! ( -- * Event Event , on, off , mapEvent + , mapEventObj -- * Basic events *************** *** 122,126 **** --------------------------------------------------------------------} -- | 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. --- 123,127 ---- --------------------------------------------------------------------} -- | 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. *************** *** 135,140 **** -- | 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 {-------------------------------------------------------------------- --- 136,144 ---- -- | 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 ! ! -- | Change the object\'s type in the event. ! mapEventObj :: (w2 -> w1) -> Event w1 a -> Event w2 a ! mapEventObj f (Event attr off) = Event (mapAttrObj f attr) (mapProp f off) {-------------------------------------------------------------------- *************** *** 360,362 **** newStdEvent :: (w -> h) -> (h -> IO a) -> (h -> a -> IO ()) -> (h -> IO ()) -> Event w a newStdEvent map getHandler setHandler setDefHandler ! = newEvent (getHandler . map) (setHandler . map) (setDefHandler . map) \ No newline at end of file --- 364,366 ---- newStdEvent :: (w -> h) -> (h -> IO a) -> (h -> a -> IO ()) -> (h -> IO ()) -> Event w a newStdEvent map getHandler setHandler setDefHandler ! = newEvent (getHandler . map) (setHandler . map) (setDefHandler . map) Index: Menu.hs =================================================================== RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Menu.hs,v retrieving revision 1.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** Menu.hs 15 Nov 2003 10:52:30 -0000 1.17 --- Menu.hs 12 May 2004 20:42:32 -0000 1.18 *************** *** 9,16 **** The module contains all utilitites required for creation and management of menus. ! A menu is a list of items that specify options or groups of options (a submenu). ! Clicking a menu item opens a submenu or causes the application to carry out a command. ! A menu is arranged in a hierarchy. At the top level of the hierarchy is the menu bar; ! which contains a list of menus, which in turn can contain submenus. -} ----------------------------------------------------------------------------------------- --- 9,16 ---- The module contains all utilitites required for creation and management of menus. ! A menu is a list of items that specify options or groups of options (a submenu). ! Clicking a menu item opens a submenu or causes the application to carry out a command. ! A menu is arranged in a hierarchy. At the top level of the hierarchy is the menu bar; ! which contains a list of menus, which in turn can contain submenus. -} ----------------------------------------------------------------------------------------- *************** *** 20,23 **** --- 20,25 ---- , popupMenu, trackPopupMenu -- * Menu items + -- ** Action based items + , MenuActionItem, menuActionItemAt, menuActionItem, getMenuAction -- ** Command items , MenuItem, menuitemAt, menuitem *************** *** 41,52 **** import Graphics.UI.GIO.Events import Graphics.UI.GIO.Window {-------------------------------------------------------------------- Menus --------------------------------------------------------------------} - -- | 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 (the menu bar) --- 43,52 ---- import Graphics.UI.GIO.Events import Graphics.UI.GIO.Window + import Graphics.UI.GIO.Action + import Graphics.UI.GIO.MenuType {-------------------------------------------------------------------- Menus --------------------------------------------------------------------} -- | The main application menu (the menu bar) *************** *** 75,79 **** -- | The 'popupMenu' function creates a popup menu. The menu is initially empty. ! -- You can populate it with items by using the 'menuitemAt', 'menucheckAt', -- 'menuRadioItemAt' or 'menulineAt' functions. Using the 'menuAt' you can create nested submenus. popupMenu :: [Prop Menu] -> IO Menu --- 75,79 ---- -- | The 'popupMenu' function creates a popup menu. The menu is initially empty. ! -- You can populate it with items by using the 'menuitemAt', 'menucheckAt', -- 'menuRadioItemAt' or 'menulineAt' functions. Using the 'menuAt' you can create nested submenus. popupMenu :: [Prop Menu] -> IO Menu *************** *** 103,107 **** instance Positioned Menu where pos = readAttr "pos" (Lib.getMenuItemPos . hmenu) ! instance Deadly Menu where destroyWidget m = Lib.destroyMenu (hmenu m) --- 103,107 ---- instance Positioned Menu where pos = readAttr "pos" (Lib.getMenuItemPos . hmenu) ! instance Deadly Menu where destroyWidget m = Lib.destroyMenu (hmenu m) *************** *** 109,226 **** -------------------------------------------------------------------- ! -- 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 = newStdAttr hitem Lib.getMenuItemEnabled Lib.setMenuItemEnabled ! instance Commanding MenuItem where ! command = newStdEvent hitem Lib.getMenuCommandHandler Lib.setMenuCommandHandler Lib.setMenuCommandDefHandler ! ! instance DynamicUpdate MenuItem where ! update = newStdEvent hitem Lib.getMenuUpdateHandler Lib.setMenuUpdateHandler Lib.setMenuUpdateDefHandler ! instance Titled MenuItem where ! title = newStdAttr hitem Lib.getMenuLabel Lib.setMenuLabel ! instance Accelerated MenuItem where ! accel = newStdAttr hitem Lib.getMenuItemAccel Lib.setMenuItemAccel ! instance HasIcon MenuItem where ! icon = newStdAttr hitem Lib.getMenuItemBitmap Lib.setMenuItemBitmap ! ! instance Tipped MenuItem where ! tooltip = newStdAttr hitem Lib.getMenuTip Lib.setMenuTip ! instance Positioned MenuItem where pos = readAttr "pos" (Lib.getMenuItemPos . hitem) ! instance Deadly MenuItem where destroyWidget m = Lib.destroyMenu (hitem m) destroy = newStdEvent hitem Lib.getMenuDestroyHandler Lib.setMenuDestroyHandler Lib.setMenuDestroyDefHandler ! -------------------------------------------------------------------- -- Menu radio items -------------------------------------------------------------------- ! -- | Radio menu items are labeled entries in a menu with bookmark. -- Sometimes, a group of menu items corresponds to a set of mutually exclusive options. -- In this case, you can indicate the selected option by using a selected radio menu item. -- To check a menu item use the 'checked' attribute. ! newtype MenuRadioItem = MenuRadioItem MenuHandle ! hradioitem (MenuRadioItem h) = h -- | Create a radio menu item and insert it at specified position. menuRadioItemAt :: Maybe Int -- ^ The position where to place the item ! -- or Nothing if you want to append it. -> [Prop MenuRadioItem] -- ^ The setup of the radio item attributes -> Menu -- ^ The parent menu -> IO MenuRadioItem -- ^ The created radio item ! menuRadioItemAt pos props menu ! = do mradioitem <- do hradioitem <- Lib.insertMenuRadioItem (hmenu menu) pos ! return (MenuRadioItem hradioitem) ! set mradioitem props ! return mradioitem ! -- | The function is the same as the 'menuRadioItemAt' function but always appends the item. The 'menuRadioItem' -- function is semantically equal to @menuRadioItemAt Nothing@ menuRadioItem :: [Prop MenuRadioItem] -> Menu -> IO MenuRadioItem ! menuRadioItem = menuRadioItemAt Nothing ! ! instance Able MenuRadioItem where ! enabled = newStdAttr hradioitem Lib.getMenuItemEnabled Lib.setMenuItemEnabled ! ! instance Commanding MenuRadioItem where ! command = newStdEvent hradioitem Lib.getMenuCommandHandler Lib.setMenuCommandHandler Lib.setMenuCommandDefHandler ! ! instance DynamicUpdate MenuRadioItem where ! update = newStdEvent hradioitem Lib.getMenuUpdateHandler Lib.setMenuUpdateHandler Lib.setMenuUpdateDefHandler ! ! instance Positioned MenuRadioItem where ! pos = readAttr "pos" (Lib.getMenuItemPos . hradioitem) ! ! instance Checked MenuRadioItem where ! checked = newStdAttr hradioitem Lib.getMenuItemChecked Lib.setMenuItemChecked ! ! instance Deadly MenuRadioItem where ! destroyWidget m = Lib.destroyMenu (hradioitem m) ! destroy = newStdEvent hradioitem Lib.getMenuDestroyHandler Lib.setMenuDestroyHandler Lib.setMenuDestroyDefHandler ! ! instance Titled MenuRadioItem where ! title = newStdAttr hradioitem Lib.getMenuLabel Lib.setMenuLabel ! ! instance Accelerated MenuRadioItem where ! accel = newStdAttr hradioitem Lib.getMenuItemAccel Lib.setMenuItemAccel ! ! instance Tipped MenuRadioItem where ! tooltip = newStdAttr hradioitem Lib.getMenuTip Lib.setMenuTip -- | The 'setMenuRadioGroup' function specifies a set of mutually exclusive options. setMenuRadioGroup :: [MenuRadioItem] -> IO () ! setMenuRadioGroup items = Lib.setMenuRadioGroup (map hradioitem items) ! -------------------------------------------------------------------- -- Checked menu items -------------------------------------------------------------------- -- | Checked menu items are labeled entries in a menu with check mark. ! -- Applications typically check or clear a menu item to indicate whether -- an option is in effect. ! newtype MenuCheck = MenuCheck MenuHandle ! hcheck (MenuCheck h) = h -- | Create a check menu item and insert it at specified position. --- 109,215 ---- -------------------------------------------------------------------- ! -- Action based menu items -------------------------------------------------------------------- ! data MenuActionItem a = MenuActionItem !MenuHandle !a ! hitem (MenuActionItem h action) = h ! menuActionItemAt :: IsAction a => Maybe Int -> [Prop (MenuActionItem a)] -> a -> Menu -> IO (MenuActionItem a) ! menuActionItemAt pos props action menu = do ! mitem <- do ! hitem <- Lib.insertMenuItem (haction action) (hmenu menu) pos ! return (MenuActionItem hitem action) ! set mitem props ! return mitem ! menuActionItem :: IsAction a => [Prop (MenuActionItem a)] -> a -> Menu -> IO (MenuActionItem a) ! menuActionItem = menuActionItemAt Nothing ! getMenuAction :: MenuActionItem a -> a ! getMenuAction (MenuActionItem h action) = action ! instance Able a => Able (MenuActionItem a) where ! enabled = mapAttrObj getMenuAction enabled ! instance Commanding a => Commanding (MenuActionItem a) where ! command = mapEventObj getMenuAction command ! instance DynamicUpdate a => DynamicUpdate (MenuActionItem a) where ! update = mapEventObj getMenuAction update ! instance Titled a => Titled (MenuActionItem a) where ! title = mapAttrObj getMenuAction title ! ! instance HasIcon a => HasIcon (MenuActionItem a) where ! icon = mapAttrObj getMenuAction icon ! ! instance Tipped a => Tipped (MenuActionItem a) where ! tooltip = mapAttrObj getMenuAction tooltip ! ! instance Checked a => Checked (MenuActionItem a) where ! checked = mapAttrObj getMenuAction checked ! ! instance Accelerated a => Accelerated (MenuActionItem a) where ! accel = mapAttrObj getMenuAction accel ! ! instance Positioned (MenuActionItem a) where pos = readAttr "pos" (Lib.getMenuItemPos . hitem) ! instance Deadly (MenuActionItem a) where destroyWidget m = Lib.destroyMenu (hitem m) destroy = newStdEvent hitem Lib.getMenuDestroyHandler Lib.setMenuDestroyHandler Lib.setMenuDestroyDefHandler ! ! -------------------------------------------------------------------- ! -- Menu items ! -------------------------------------------------------------------- ! -- | Menu items are labeled entries in a menu. ! type MenuItem = MenuActionItem Action ! ! -- | Create a menu item and insert it at specified position. ! menuitemAt :: Maybe Int -> [Prop MenuItem] -> Menu -> IO MenuItem ! menuitemAt pos props menu = do ! act <- action [] ! menuActionItemAt pos props act menu ! ! -- | Create a menu item and appends it to parent menu. ! menuitem :: [Prop MenuItem] -> Menu -> IO MenuItem ! menuitem = menuitemAt Nothing ! -------------------------------------------------------------------- -- Menu radio items -------------------------------------------------------------------- ! -- | Radio menu items are labeled entries in a menu with bookmark. -- Sometimes, a group of menu items corresponds to a set of mutually exclusive options. -- In this case, you can indicate the selected option by using a selected radio menu item. -- To check a menu item use the 'checked' attribute. ! type MenuRadioItem = MenuActionItem RadioAction -- | Create a radio menu item and insert it at specified position. menuRadioItemAt :: Maybe Int -- ^ The position where to place the item ! -- or Nothing if you want to append it. -> [Prop MenuRadioItem] -- ^ The setup of the radio item attributes -> Menu -- ^ The parent menu -> IO MenuRadioItem -- ^ The created radio item ! menuRadioItemAt pos props menu = do ! act <- radioAction [] ! menuActionItemAt pos props act menu ! -- | The function is the same as the 'menuRadioItemAt' function but always appends the item. The 'menuRadioItem' -- function is semantically equal to @menuRadioItemAt Nothing@ menuRadioItem :: [Prop MenuRadioItem] -> Menu -> IO MenuRadioItem ! menuRadioItem = menuRadioItemAt Nothing -- | The 'setMenuRadioGroup' function specifies a set of mutually exclusive options. setMenuRadioGroup :: [MenuRadioItem] -> IO () ! setMenuRadioGroup items = setActionRadioGroup (map getMenuAction items) ! -------------------------------------------------------------------- -- Checked menu items -------------------------------------------------------------------- -- | Checked menu items are labeled entries in a menu with check mark. ! -- Applications typically check or clear a menu item to indicate whether -- an option is in effect. ! type MenuCheck = MenuActionItem CheckAction -- | Create a check menu item and insert it at specified position. *************** *** 230,271 **** -> Menu -- ^ The parent menu -> IO MenuCheck -- ^ The created checked item ! menucheckAt pos props menu ! = do mcheck <- do mcheck <- Lib.insertMenuCheckItem (hmenu menu) pos ! return (MenuCheck mcheck) ! set mcheck props ! return mcheck -- | The function is the same as the 'menucheckAt' function but always appends the item. The 'menucheck' -- function is semantically equal to @menucheckAt Nothing@ menucheck :: [Prop MenuCheck] -> Menu -> IO MenuCheck ! menucheck = menucheckAt Nothing ! ! instance Able MenuCheck where ! enabled = newStdAttr hcheck Lib.getMenuItemEnabled Lib.setMenuItemEnabled ! ! instance Commanding MenuCheck where ! command = newStdEvent hcheck Lib.getMenuCommandHandler Lib.setMenuCommandHandler Lib.setMenuCommandDefHandler ! ! instance DynamicUpdate MenuCheck where ! update = newStdEvent hcheck Lib.getMenuUpdateHandler Lib.setMenuUpdateHandler Lib.setMenuUpdateDefHandler ! ! instance Titled MenuCheck where ! title = newStdAttr hcheck Lib.getMenuLabel Lib.setMenuLabel ! ! instance Accelerated MenuCheck where ! accel = newStdAttr hcheck Lib.getMenuItemAccel Lib.setMenuItemAccel ! ! instance Tipped MenuCheck where ! tooltip = newStdAttr hcheck Lib.getMenuTip Lib.setMenuTip ! ! instance Positioned MenuCheck where ! pos = readAttr "pos" (Lib.getMenuItemPos . hcheck) ! ! instance Checked MenuCheck where ! checked = newStdAttr hcheck Lib.getMenuItemChecked Lib.setMenuItemChecked ! ! instance Deadly MenuCheck where ! destroyWidget m = Lib.destroyMenu (hcheck m) ! destroy = newStdEvent hcheck Lib.getMenuDestroyHandler Lib.setMenuDestroyHandler Lib.setMenuDestroyDefHandler -------------------------------------------------------------------- --- 219,230 ---- -> Menu -- ^ The parent menu -> IO MenuCheck -- ^ The created checked item ! menucheckAt pos props menu = do ! act <- checkAction [] ! menuActionItemAt pos props act menu -- | The function is the same as the 'menucheckAt' function but always appends the item. The 'menucheck' -- function is semantically equal to @menucheckAt Nothing@ menucheck :: [Prop MenuCheck] -> Menu -> IO MenuCheck ! menucheck = menucheckAt Nothing -------------------------------------------------------------------- Index: ToolBar.hs =================================================================== RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/ToolBar.hs,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** ToolBar.hs 15 Nov 2003 10:52:30 -0000 1.8 --- ToolBar.hs 12 May 2004 20:42:32 -0000 1.9 *************** *** 15,18 **** --- 15,19 ---- -- * Creation ToolBar, toolBar + , ToolActionButton, toolActionButtonAt, toolActionButton, getToolButtonAction , ToolButton, toolButtonAt, toolButton , ToolCheckButton, toolCheckButtonAt, toolCheckButton *************** *** 26,29 **** --- 27,31 ---- import Graphics.UI.GIO.Types import Graphics.UI.GIO.Menu + import Graphics.UI.GIO.Action import qualified Graphics.UI.Port as Lib *************** *** 52,130 **** -------------------------------------------------------------------- ! data ToolButton = ToolButton {hbutton :: ToolHandle} ! toolButtonAt :: Maybe Int -> [Prop ToolButton] -> ToolBar -> IO ToolButton ! toolButtonAt pos props (ToolBar hwnd) = do ! btn <- do hbtn <- Lib.insertToolButton hwnd pos ! return (ToolButton hbtn) set btn props return btn ! toolButton :: [Prop ToolButton] -> ToolBar -> IO ToolButton ! toolButton = toolButtonAt Nothing ! instance Able ToolButton where ! enabled = newStdAttr hbutton Lib.getToolButtonEnabled Lib.setToolButtonEnabled ! instance Commanding ToolButton where ! command = ! newStdEvent hbutton Lib.getToolCommandHandler Lib.setToolCommandHandler Lib.setToolCommandDefHandler ! instance HasIcon ToolButton where ! icon = newStdAttr hbutton Lib.getToolButtonBitmap Lib.setToolButtonBitmap ! instance Positioned ToolButton where ! pos = readAttr "pos" (Lib.getToolItemPos . hbutton) ! instance Tipped ToolButton where ! tooltip = newStdAttr hbutton Lib.getToolButtonTip Lib.setToolButtonTip ! instance Titled ToolButton where ! title = newStdAttr hbutton Lib.getToolButtonText Lib.setToolButtonText ! instance Deadly ToolButton where destroyWidget t = Lib.destroyToolItem (hbutton t) destroy = newStdEvent hbutton Lib.getToolDestroyHandler Lib.setToolDestroyHandler Lib.setToolDestroyDefHandler -------------------------------------------------------------------- ! -- ToolCheckButton -------------------------------------------------------------------- ! data ToolCheckButton = ToolCheckButton {hcheck :: ToolHandle} ! ! toolCheckButtonAt :: Maybe Int -> [Prop ToolCheckButton] -> ToolBar -> IO ToolCheckButton ! toolCheckButtonAt pos props (ToolBar hwnd) = do ! btn <- do hbtn <- Lib.insertToolCheckButton hwnd pos ! return (ToolCheckButton hbtn) ! set btn props ! return btn ! ! toolCheckButton :: [Prop ToolCheckButton] -> ToolBar -> IO ToolCheckButton ! toolCheckButton = toolCheckButtonAt Nothing ! ! instance Able ToolCheckButton where ! enabled = newStdAttr hcheck Lib.getToolButtonEnabled Lib.setToolButtonEnabled ! ! instance Commanding ToolCheckButton where ! command = newStdEvent hcheck Lib.getToolCommandHandler Lib.setToolCommandHandler Lib.setToolCommandDefHandler ! instance HasIcon ToolCheckButton where ! icon = newStdAttr hcheck Lib.getToolButtonBitmap Lib.setToolButtonBitmap ! instance Positioned ToolCheckButton where ! pos = readAttr "pos" (Lib.getToolItemPos . hcheck) ! instance Tipped ToolCheckButton where ! tooltip = newStdAttr hcheck Lib.getToolButtonTip Lib.setToolButtonTip ! instance Titled ToolCheckButton where ! title = newStdAttr hcheck Lib.getToolButtonText Lib.setToolButtonText ! instance Checked ToolCheckButton where ! checked = newStdAttr hcheck Lib.getToolButtonChecked Lib.setToolButtonChecked ! instance Deadly ToolCheckButton where ! destroyWidget t = Lib.destroyToolItem (hcheck t) ! destroy = newStdEvent hcheck Lib.getToolDestroyHandler Lib.setToolDestroyHandler Lib.setToolDestroyDefHandler -------------------------------------------------------------------- --- 54,126 ---- -------------------------------------------------------------------- ! data ToolActionButton a = ToolActionButton !ToolHandle !a ! hbutton (ToolActionButton handle action) = handle ! toolActionButtonAt :: IsAction a => Maybe Int -> [Prop (ToolActionButton a)] -> a -> ToolBar -> IO (ToolActionButton a) ! toolActionButtonAt pos props action (ToolBar hwnd) = do ! btn <- do ! hbtn <- Lib.insertToolButton (haction action) hwnd pos ! return (ToolActionButton hbtn action) set btn props return btn ! toolActionButton :: IsAction a => [Prop (ToolActionButton a)] -> a -> ToolBar -> IO (ToolActionButton a) ! toolActionButton = toolActionButtonAt Nothing ! getToolButtonAction :: ToolActionButton a -> a ! getToolButtonAction (ToolActionButton handle action) = action ! instance Able a => Able (ToolActionButton a) where ! enabled = mapAttrObj getToolButtonAction enabled ! instance Commanding a => Commanding (ToolActionButton a) where ! command = mapEventObj getToolButtonAction command ! instance HasIcon a => HasIcon (ToolActionButton a) where ! icon = mapAttrObj getToolButtonAction icon ! instance Tipped a => Tipped (ToolActionButton a) where ! tooltip = mapAttrObj getToolButtonAction tooltip ! instance Titled a => Titled (ToolActionButton a) where ! title = mapAttrObj getToolButtonAction shortTitle ! instance Checked a => Checked (ToolActionButton a) where ! checked = mapAttrObj getToolButtonAction checked ! ! instance Positioned (ToolActionButton a) where ! pos = readAttr "pos" (Lib.getToolItemPos . hbutton) ! ! instance Deadly (ToolActionButton a) where destroyWidget t = Lib.destroyToolItem (hbutton t) destroy = newStdEvent hbutton Lib.getToolDestroyHandler Lib.setToolDestroyHandler Lib.setToolDestroyDefHandler -------------------------------------------------------------------- ! -- ToolButton -------------------------------------------------------------------- ! type ToolButton = ToolActionButton Action ! toolButtonAt :: Maybe Int -> [Prop ToolButton] -> ToolBar -> IO ToolButton ! toolButtonAt pos props toolbar = do ! act <- action [] ! toolActionButtonAt pos props act toolbar ! toolButton :: [Prop ToolButton] -> ToolBar -> IO ToolButton ! toolButton = toolButtonAt Nothing ! -------------------------------------------------------------------- ! -- ToolCheckButton ! -------------------------------------------------------------------- ! type ToolCheckButton = ToolActionButton CheckAction ! toolCheckButtonAt :: Maybe Int -> [Prop ToolCheckButton] -> ToolBar -> IO ToolCheckButton ! toolCheckButtonAt pos props toolbar = do ! act <- checkAction [] ! toolActionButtonAt pos props act toolbar ! toolCheckButton :: [Prop ToolCheckButton] -> ToolBar -> IO ToolCheckButton ! toolCheckButton = toolCheckButtonAt Nothing -------------------------------------------------------------------- *************** *** 132,174 **** -------------------------------------------------------------------- ! data ToolRadioButton = ToolRadioButton {hradio :: ToolHandle} toolRadioButtonAt :: Maybe Int -> [Prop ToolRadioButton] -> ToolBar -> IO ToolRadioButton ! toolRadioButtonAt pos props (ToolBar hwnd) = do ! btn <- do hbtn <- Lib.insertToolRadioButton hwnd pos ! return (ToolRadioButton hbtn) ! set btn props ! return btn toolRadioButton :: [Prop ToolRadioButton] -> ToolBar -> IO ToolRadioButton toolRadioButton = toolRadioButtonAt Nothing ! instance Able ToolRadioButton where ! enabled = newStdAttr hradio Lib.getToolButtonEnabled Lib.setToolButtonEnabled ! ! instance Commanding ToolRadioButton where ! command = newStdEvent hradio Lib.getToolCommandHandler Lib.setToolCommandHandler Lib.setToolCommandDefHandler ! ! instance HasIcon ToolRadioButton where ! icon = newStdAttr hradio Lib.getToolButtonBitmap Lib.setToolButtonBitmap ! ! instance Positioned ToolRadioButton where ! pos = readAttr "pos" (Lib.getToolItemPos . hradio) ! ! instance Tipped ToolRadioButton where ! tooltip = newStdAttr hradio Lib.getToolButtonTip Lib.setToolButtonTip ! ! instance Titled ToolRadioButton where ! title = newStdAttr hradio Lib.getToolButtonText Lib.setToolButtonText ! ! instance Checked ToolRadioButton where ! checked = newStdAttr hradio Lib.getToolButtonChecked Lib.setToolButtonChecked ! ! instance Deadly ToolRadioButton where ! destroyWidget t = Lib.destroyToolItem (hradio t) ! destroy = newStdEvent hradio Lib.getToolDestroyHandler Lib.setToolDestroyHandler Lib.setToolDestroyDefHandler ! setToolRadioGroup :: [ToolRadioButton] -> IO () ! setToolRadioGroup btns = Lib.setToolRadioGroup (map hradio btns) -------------------------------------------------------------------- --- 128,144 ---- -------------------------------------------------------------------- ! type ToolRadioButton = ToolActionButton RadioAction toolRadioButtonAt :: Maybe Int -> [Prop ToolRadioButton] -> ToolBar -> IO ToolRadioButton ! toolRadioButtonAt pos props toolbar = do ! act <- radioAction [] ! toolActionButtonAt pos props act toolbar toolRadioButton :: [Prop ToolRadioButton] -> ToolBar -> IO ToolRadioButton toolRadioButton = toolRadioButtonAt Nothing ! -- | The 'setToolRadioGroup' function specifies a set of mutually exclusive options. setToolRadioGroup :: [ToolRadioButton] -> IO () ! setToolRadioGroup items = setActionRadioGroup (map getToolButtonAction items) -------------------------------------------------------------------- *************** *** 176,210 **** -------------------------------------------------------------------- ! data ToolDropDownButton = ToolDropDownButton {hdropdown :: ToolHandle} toolDropDownButtonAt :: Maybe Int -> Menu -> [Prop ToolDropDownButton] -> ToolBar -> IO ToolDropDownButton ! toolDropDownButtonAt pos menu props (ToolBar hwnd) = do ! btn <- do hbtn <- Lib.insertToolDropDownButton hwnd (hmenu menu) pos ! return (ToolDropDownButton hbtn) ! set btn props ! return btn toolDropDownButton :: Menu -> [Prop ToolDropDownButton] -> ToolBar -> IO ToolDropDownButton toolDropDownButton = toolDropDownButtonAt Nothing - instance Able ToolDropDownButton where - enabled = newStdAttr hdropdown Lib.getToolButtonEnabled Lib.setToolButtonEnabled - - instance HasIcon ToolDropDownButton where - icon = newStdAttr hdropdown Lib.getToolButtonBitmap Lib.setToolButtonBitmap - - instance Positioned ToolDropDownButton where - pos = readAttr "pos" (Lib.getToolItemPos . hdropdown) - - instance Tipped ToolDropDownButton where - tooltip = newStdAttr hdropdown Lib.getToolButtonTip Lib.setToolButtonTip - - instance Titled ToolDropDownButton where - title = newStdAttr hdropdown Lib.getToolButtonText Lib.setToolButtonText - - instance Deadly ToolDropDownButton where - destroyWidget t = Lib.destroyToolItem (hdropdown t) - destroy = newStdEvent hdropdown Lib.getToolDestroyHandler Lib.setToolDestroyHandler Lib.setToolDestroyDefHandler - -------------------------------------------------------------------- -- ToolLine --- 146,159 ---- -------------------------------------------------------------------- ! type ToolDropDownButton = ToolActionButton DropDownAction toolDropDownButtonAt :: Maybe Int -> Menu -> [Prop ToolDropDownButton] -> ToolBar -> IO ToolDropDownButton ! toolDropDownButtonAt pos menu props toolbar = do ! act <- dropDownAction menu [] ! toolActionButtonAt pos props act toolbar toolDropDownButton :: Menu -> [Prop ToolDropDownButton] -> ToolBar -> IO ToolDropDownButton toolDropDownButton = toolDropDownButtonAt Nothing -------------------------------------------------------------------- -- ToolLine Index: Types.hs =================================================================== RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Types.hs,v retrieving revision 1.19 retrieving revision 1.20 diff -C2 -d -r1.19 -r1.20 *** Types.hs 6 May 2004 10:27:47 -0000 1.19 --- Types.hs 12 May 2004 20:42:32 -0000 1.20 *************** *** 111,114 **** --- 111,115 ---- , MenuHandle , ToolHandle + , ActionHandle , IndicatorHandle , FontHandle |
