[htoolkit-cvs] gio/src/Graphics/UI/GIO Attributes.hs,1.14,1.15 Controls.hs,1.16,1.17

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

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

Modified Files:
	Attributes.hs Controls.hs 
Log Message:
The Select class is renamed to CommandItems. Added new class methods:
appendItem, insertItem, removeItem, removeAllItems


Index: Attributes.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Attributes.hs,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** Attributes.hs	8 Jul 2003 20:36:26 -0000	1.14
--- Attributes.hs	12 Jul 2003 08:15:29 -0000	1.15
***************
*** 74,78 ****
               -- ** Selection
               , Checked, checked
!              , Select, items
               , SingleSelect, selected
               , MultiSelect, selection
--- 74,78 ----
               -- ** Selection
               , Checked, checked
!              , CommandItems, items, appendItem, insertItem, removeItem, removeAllItems
               , SingleSelect, selected
               , MultiSelect, selection
***************
*** 301,306 ****
  
  -- | Widgets that have selectable items, like popup controls.
! class Select w where
    items :: Attr w [(String,IO ())]
    
  -- | Widgets that have a single selection (like radio control groups).
--- 301,310 ----
  
  -- | Widgets that have selectable items, like popup controls.
! class CommandItems w where
    items :: Attr w [(String,IO ())]
+   appendItem :: w -> (String,IO ()) -> IO ()
+   insertItem :: w -> Int -> (String,IO ()) -> IO ()
+   removeItem :: w -> Int -> IO ()
+   removeAllItems :: w -> IO ()
    
  -- | Widgets that have a single selection (like radio control groups).

Index: Controls.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Controls.hs,v
retrieving revision 1.16
retrieving revision 1.17
diff -C2 -d -r1.16 -r1.17
*** Controls.hs	10 Jul 2003 20:50:24 -0000	1.16
--- Controls.hs	12 Jul 2003 08:15:29 -0000	1.17
***************
*** 36,39 ****
--- 36,55 ----
  
  --------------------------------------------------------------------
+ --  Helper functions
+ --------------------------------------------------------------------
+ 
+ insertAt :: Int -> a -> [a] -> [a]
+ insertAt pos v [] = []
+ insertAt pos v (x:xs)
+   | pos == 0  = v : xs
+   | otherwise = x : insertAt (pos-1) v xs
+         
+ removeAt :: Int -> [a] -> [a]
+ removeAt pos [] = []
+ removeAt pos (x:xs)
+   | pos == 0  = xs
+   | otherwise = x : removeAt (pos-1) xs
+       	  
+ --------------------------------------------------------------------
  --  Label
  --------------------------------------------------------------------
***************
*** 190,194 ****
  
  
! instance Select Popup where
    items
      = newAttr (\w -> getVar (pitems w))
--- 206,210 ----
  
  
! instance CommandItems Popup where
    items
      = newAttr (\w -> getVar (pitems w))
***************
*** 198,201 ****
--- 214,237 ----
                             set w [selected =: 0])
  
+   appendItem p item@(title,action) = do
+     items <- takeVar (pitems p)
+     Port.appendPopUpItem (phandle p) title
+     putVar (pitems p) (items++[item])
+ 
+   insertItem p pos item@(title,action) = do
+     items <- takeVar (pitems p)
+     Port.insertPopUpItem (phandle p) pos title
+     putVar (pitems p) (insertAt pos item items)
+ 
+   removeItem p pos = do
+     items <- takeVar (pitems p)
+     Port.removePopUpItem (phandle p) pos
+     putVar (pitems p) (removeAt pos items)
+ 
+   removeAllItems p = do
+     items <- takeVar (pitems p)
+     Port.removeAllPopUpItems (phandle p)
+     putVar (pitems p) []
+ 
  instance SingleSelect Popup where
    selected
***************
*** 250,254 ****
    when (i>=0 && i < length xs) (snd (xs!!i))  -- invoke appropiate handler
  
! instance Select ListBox where
    items
      = newAttr (\w -> getVar (lbitems w))
--- 286,290 ----
    when (i>=0 && i < length xs) (snd (xs!!i))  -- invoke appropiate handler
  
! instance CommandItems ListBox where
    items
      = newAttr (\w -> getVar (lbitems w))
***************
*** 256,259 ****
--- 292,316 ----
                             mapM_ (Port.appendListBoxItem (lbhandle w) . fst) xs
                             setVar (lbitems w) xs)
+                            
+   appendItem lb item@(title,action) = do
+     items <- takeVar (lbitems lb)
+     Port.appendListBoxItem (lbhandle lb) title
+     putVar (lbitems lb) (items++[item])
+   
+   insertItem lb pos item@(title,action) = do
+     items <- takeVar (lbitems lb)
+     Port.insertListBoxItem (lbhandle lb) pos title
+     putVar (lbitems lb) (insertAt pos item items)
+   
+   removeItem lb pos = do
+     items <- takeVar (lbitems lb)
+     Port.removeListBoxItem (lbhandle lb) pos
+     putVar (lbitems lb) (removeAt pos items)     
+   
+   removeAllItems lb = do
+     items <- takeVar (lbitems lb)
+     Port.removeAllListBoxItems (lbhandle lb)
+     putVar (lbitems lb) []
+ 
  
  instance SingleSelect ListBox where