module HTk.Widgets.ComboBox (
ComboBox,
newComboBox,
pick,
entrySubwidget,
listBoxSubwidget
) where
import HTk.Kernel.Core
import HTk.Kernel.BaseClasses(Widget)
import HTk.Kernel.Configuration
import Util.Computation
import Events.Synchronized
import Events.Destructible
import HTk.Kernel.Packer
import HTk.Widgets.Entry
import HTk.Widgets.ListBox
import HTk.Tix.Subwidget
data GUIValue a =>
ComboBox a = ComboBox GUIOBJECT (Entry a) (ListBox a)
deriving Eq
entrySubwidget :: GUIValue a => ComboBox a -> Entry a
entrySubwidget (ComboBox _ x _) = x
listBoxSubwidget :: GUIValue a => ComboBox a -> ListBox a
listBoxSubwidget (ComboBox _ _ x) = x
newComboBox :: (GUIValue a, Container par) =>
par
-> Bool
-> [Config (ComboBox a)]
-> IO (ComboBox a)
newComboBox par editable cnf =
do
cb <- createGUIObject (toGUIObject par) (COMBOBOX editable) comboBoxMethods
e <- createAsSubwidget cb
lb <- createAsSubwidget cb
configure (ComboBox cb e lb) cnf
pick :: GUIValue a => Int -> Config (ComboBox a)
pick i cb = execMethod cb (\nm -> tkPick nm i) >> return cb
comboBoxMethods :: Methods
comboBoxMethods = Methods (cgetCmd defMethods)
(csetCmd defMethods)
tkCreateComboBox
(packCmd defMethods)
(gridCmd defMethods)
(destroyCmd defMethods)
(bindCmd defMethods)
(unbindCmd defMethods)
(cleanupCmd defMethods)
instance GUIValue a => GUIObject (ComboBox a) where
toGUIObject (ComboBox f _ _) = f
cname _ = "ComboBox"
instance (GUIValue a, GUIValue [a]) => HasValue (ComboBox a) [a] where
value vals w =
execMethod w (\nm -> tkInsert nm 0 (map toGUIValue vals)) >> return w
getValue w = evalMethod w (\nm -> tkGet nm)
instance GUIValue a => Widget (ComboBox a)
instance GUIValue a => Destroyable (ComboBox a) where
destroy = destroy . toGUIObject
instance GUIValue a => HasBorder (ComboBox a)
instance GUIValue a => HasAnchor (ComboBox a)
instance GUIValue a => HasColour (ComboBox a) where
legalColourID = hasBackGroundColour
instance GUIValue a => HasSize (ComboBox a)
instance GUIValue a => Synchronized (ComboBox a) where
synchronize = synchronize . toGUIObject
instance GUIValue a => HasEnable (ComboBox a)
tkCreateComboBox :: ObjectName -> ObjectKind -> ObjectName ->
ObjectID -> [ConfigOption] -> TclScript
tkCreateComboBox _ (COMBOBOX editable) name _ opts =
["tixComboBox " ++ show name ++ " -editable " ++ show editable ++
showConfigs opts]
tkCreateComboBox _ _ _ _ _ = []
tkInsert :: ObjectName -> Int -> [GUIVALUE] -> TclScript
tkInsert name inx elems =
[tkDelete name "0" "end",
show name ++ " subwidget listbox insert " ++ show inx ++ " " ++
showElements elems]
tkDelete :: ObjectName -> String -> String -> TclCmd
tkDelete name first last =
show name ++ " subwidget listbox delete " ++ first ++ " " ++ last
tkGet :: ObjectName -> TclScript
tkGet name = [show name ++ " subwidget entry get"]
showElements :: [GUIVALUE] -> String
showElements = concatMap (++ " ") . (map show)
tkPick :: ObjectName -> Int -> TclScript
tkPick name index = [show name ++ " pick " ++ show index]