module TclWidgets (
	module TclWidgets,
	module TclPrimExports,module GUIMonad,
	module TclConf) 
where

-- This module defines each of the individual TclHaskell widgets that
-- comes with TclHaskell.  It includes the `Conf w' with the
-- supporting type class protection machinery.

import Char
import List
import IO
import GUIMonad
import TclConf
import qualified TclPrimImpl as T
import TclPrimExports
import Maybe

-- helpers

start :: GUI () -> IO ()
start gui = T.runLoop $ \i -> runGUI i gui

getTclTime :: GUI Double
getTclTime = withGUIInfo T.getTime

quit :: GUI ()
quit = withGUIInfo T.quit

tcl_callback :: String -> ([String]-> IO ()) 
	     -> GUI (String,Remover)
tcl_callback s act = do
 (s,rm) <- withGUIInfo $ \i -> T.tcl_callback i s act
 return (s,liftIO rm)

tcl_debug :: Bool -> GUI ()
tcl_debug b = withGUIInfo $ T.tcl_debug b

mkChildOf,mkSibling :: Widget a b -> GUI WPath
mkChildOf = liftIO . T.mkChildOf
mkSibling = liftIO . T.mkSibling

tcl_eventUntil :: GUI Bool -> GUI ()
tcl_eventUntil ref = withGUIInfo $ \g -> T.tcl_eventUntil g (runGUI g ref)
 
-- timer

after :: Int -> GUI () -> GUI Remover
after n p = 
 fmap liftIO $ withGUIInfo $ \i -> T.after n (runGUI i p) i

-- Basic Widget class

focus :: Widget a b -> GUI ()
focus w = tcl_ ["focus",wpath w]

destroy :: Widget a w -> GUI ()
destroy = liftIO . T.destroy

addFinaliserW :: Widget a w -> GUI () -> GUI ()
addFinaliserW w gui = do io <- fromGUI gui;liftIO $ T.addFinaliserW w io

-- packing widgets

gridAdd :: PWidget w -> Coord -> [GridInfo] -> GUI ()
gridForget :: PWidget w -> GUI ()
packAdd :: PWidget w -> [PackInfo] -> GUI ()
packForget :: PWidget w -> GUI ()

gridAdd a b c  = liftIO $ gridAdd' a b c
gridForget w = liftIO $ gridForget' w
packAdd w p  = liftIO $ packAdd' w p
packForget p = liftIO $ packForget' p 


raise :: PWidget a -> Maybe String -> GUI ()
raise w sMb = liftIO $ T.raise w sMb

lower :: PWidget a -> Maybe String -> GUI ()
lower w sMb = liftIO  $ T.lower w sMb

-- Events ----------------------------------------------------

bindArgs :: Widget a w -> (Bool,Bool,TkEvent,String) -> ([String] -> GUI ())
         -> GUI Remover
bindArgs w tk act = do
 fmap liftIO $ withGUIInfo $ \i -> T.bindArgs w tk (\x -> runGUI i (act x))

bind :: Widget a w -> TkEvent -> GUI () -> GUI Remover
bindxy :: Widget a w -> TkEvent -> ((Int,Int) -> GUI ()) -> GUI Remover
bindXY :: Widget a w -> TkEvent -> ((Int,Int) -> GUI ()) -> GUI Remover

bind w tk gui = T.bind bindArgs w tk gui
bindxy w tk gui = T.bindxy bindArgs w tk gui
bindXY w tk gui = T.bindXY bindArgs w tk gui

bindCommand :: Has_command w => Widget a w -> GUI () -> GUI Remover
bindCommand w act = 
 fmap liftIO $ withGUIInfo $ \i -> T.bindCommand w (runGUI i act)
 
-- dialog boxes

getOpenFileName :: GUI (Maybe FilePath)
getOpenFileName = withGUIInfo T.getOpenFileName 

getSaveFileName :: GUI (Maybe FilePath)
getSaveFileName = withGUIInfo $ T.getSaveFileName

-- Utility functions

mkWidget :: ([Config] -> GUIInfo -> IO (Widget a w)) 
         -> [Conf w] 
         -> GUI (Widget a w) 
mkWidget f cs = withGUIInfo $ \i -> do
 case fromConf cs of
  cfgs -> do w <- f cfgs i;return w

-- Window --------------------------------------------

-- type Window
 
instance Has_background		 Win
instance Has_borderwidth	 Win
instance Has_cursor		 Win
instance Has_height		 Win
instance Has_highlightbackground Win
instance Has_highlightcolor	 Win
instance Has_highlightthickness	 Win
instance Has_relief		 Win
instance Has_takefocus		 Win
instance Has_width		 Win
instance Has_use_menu		 Win

{-
data Geometry =
	WinSz   (Int,Int)	    | -- size
	WinPn   (Int,Int)	    | -- position
	WinSzPn (Int,Int) (Int,Int)   -- size position
-}
rootWin :: GUI Window
rootWin = withGUIInfo T.rootWin

window' :: WPath -> [Conf Win] -> GUI Window
window' nm = mkWidget (T.window' nm)

window :: [Conf Win] -> GUI Window
window = mkWidget $ T.window 

title :: Window -> String -> GUI ()
title w s = liftIO $ T.title w s

geometry :: Window -> Geometry -> GUI ()
geometry w g = liftIO $ T.geometry w g

showWindow,iconifyWindow,hideWindow :: Window -> GUI ()
showWindow = liftIO . T.showWindow
hideWindow = liftIO . T.hideWindow
iconifyWindow= liftIO . T.iconifyWindow

-- Trapping Window Deletions ---------------------------

trapDeleteWindow :: Window -> GUI () -> GUI ()
trapDeleteWindow w gui = 
 withGUIInfo $ \i -> T.trapDeleteWindow w (runGUI i gui)

-- Message ---------------------------------------------

--type Message = WWidget Messg
--data Messg 

instance Has_justify Messg
instance Has_width Messg
instance Has_aspect Messg
instance Has_text Messg

message' :: WPath -> [Conf Messg] -> GUI Message
message' nm = mkWidget $ T.message' nm 

message :: Window -> [Conf Messg] -> GUI Message
message w cs = liftIO $ T.message w (fromConf cs)


-- Menu ------------------------------------------------
 
-- type Menu = WWidget Men	-- see TclCore
-- data Men  = TkMen
 
instance Has_background  Men
instance Has_borderwidth Men
instance Has_cursor	 Men
instance Has_postcommand Men
instance Has_relief	 Men

tearoff :: Bool -> Conf Men
tearoff b = "tearoff" %% show b

menu' :: WPath -> [Conf Men] -> GUI Menu
menu' nm = mkWidget $ T.menu' nm

menu :: Has_use_menu b => Widget a b -> [Conf Men] -> GUI Menu
menu w cs = do
 m <- liftIO $ T.menu w (fromConf cs) 
 return m

popup :: Menu -> (Int,Int) -> GUI ()
popup m pos = liftIO $ T.popup m pos

menuSize :: Menu -> GUI Int
menuSize m = liftIO $ T.menuSize m


-- Menubutton ------------------------------------------------

--type Menubutton  = WWidget MB
--data MB = TkMB


instance Has_activebackground	 MB
instance Has_activeforeground	 MB
instance Has_anchor		 MB
instance Has_background		 MB
instance Has_bitmap		 MB
instance Has_borderwidth	 MB
instance Has_cursor		 MB
instance Has_font		 MB
instance Has_foreground		 MB
instance Has_height		 MB
instance Has_highlightbackground MB
instance Has_highlightcolor	 MB
instance Has_highlightthickness	 MB
instance Has_justify		 MB
instance Has_active_state 	 MB
instance Has_padx		 MB
instance Has_pady		 MB
instance Has_relief		 MB
instance Has_takefocus		 MB
instance Has_text		 MB
instance Has_underline		 MB
instance Has_use_menu		 MB
instance Has_width		 MB
instance Has_wraplength		 MB

menubutton' :: WPath -> Maybe WPath -> [Conf MB] -> GUI Menubutton
menubutton' nm ext = mkWidget $ T.menubutton' nm ext 

menubutton :: Window -> [Conf MB] -> GUI Menubutton
menubutton win cs = liftIO $ T.menubutton win (fromConf cs)
 

-- Cascade ---------------------------------------------------

--type Cascade     = MWidget CB
--data CB = TkCB

instance Has_activebackground	 CB
instance Has_activeforeground	 CB
instance Has_background		 CB
instance Has_bitmap		 CB
instance Has_font		 CB
instance Has_foreground		 CB
instance Has_active_state	 CB
instance Has_underline		 CB
instance Has_use_menu		 CB
instance Has_wgt_label		 CB

cascade' :: Menu -> Menu -> [Conf CB] -> Int -> GUI Cascade
cascade' w w' cs x = liftIO $ T.cascade w w' (fromConf cs) x

cascade :: Menu -> Menu -> [Conf CB] -> GUI Cascade
cascade w w' cs = menuSize w >>= cascade' w w' cs

-- MButton ------------------------------------

--type MButton = MWidget MBut
--data MBut    = TkMBut

instance Has_activebackground	 MBut
instance Has_activeforeground	 MBut
instance Has_background		 MBut
instance Has_bitmap		 MBut
instance Has_command		 MBut
instance Has_font		 MBut
instance Has_foreground		 MBut
instance Has_active_state	 MBut
instance Has_underline		 MBut
instance Has_wgt_label		 MBut
 
mbutton' :: Menu -> [Conf MBut] -> Int -> GUI MButton
mbutton' m cs x = liftIO $ T.mbutton m (fromConf cs) x

mbutton :: Menu -> [Conf MBut] -> GUI MButton
mbutton m cs = menuSize m >>= mbutton' m cs

-- MCheckbutton --------------------------------
 
--type MCheckbutton = MWidget MChe
--data MChe         = TkMChe

instance Has_activebackground	 MChe
instance Has_activeforeground	 MChe
instance Has_background		 MChe
instance Has_bitmap		 MChe
instance Has_command		 MChe
instance Has_font		 MChe
instance Has_foreground		 MChe
instance Has_indicatoron	 MChe
instance Has_active_state	 MChe
instance Has_selectcolor	 MChe
instance Has_underline		 MChe
instance Has_wgt_label		 MChe
 
mcheckbutton' :: Menu -> [Conf MChe] -> Int -> GUI MCheckbutton
mcheckbutton' w cs x = liftIO $ T.mcheckbutton w (fromConf cs) x

mcheckbutton :: Menu -> [Conf MChe] -> GUI MCheckbutton
mcheckbutton m cs = menuSize m >>= mcheckbutton' m cs

getMCheck :: MCheckbutton -> GUI Bool
getMCheck w = liftIO $ T.getMCheck w
 
setMCheck :: MCheckbutton -> Bool -> GUI ()
setMCheck w b = liftIO $ T.setMCheck w b

varMCheck :: MCheckbutton -> String
varMCheck = wtag

-- Separator -------------------------------------------------
 
--type Separator  = MWidget Sep
--data Sep = TkSep
  
separator :: Menu -> GUI Separator
separator m = menuSize m >>= separator' m

separator' :: Menu -> Int -> GUI Separator
separator' w n = liftIO $ T.separator w n

-- MRadiobutton ---------------------------------

--type MRadiobutton = MWidget MRB
--data MRB          = TkMRB
 
instance Has_activebackground	 MRB
instance Has_activeforeground	 MRB
instance Has_background		 MRB
instance Has_bitmap		 MRB
instance Has_command		 MRB
instance Has_font		 MRB
instance Has_foreground		 MRB
instance Has_indicatoron	 MRB
instance Has_active_state	 MRB
instance Has_selectcolor	 MRB
instance Has_underline		 MRB
instance Has_wgt_label		 MRB
 
mradiobutton' :: Menu -> [Conf MRB] -> Int -> GUI MRadiobutton
mradiobutton' w c n = liftIO $ T.mradiobutton w (fromConf c) n

mradiobutton :: Menu -> [Conf MRB] -> GUI MRadiobutton
mradiobutton m cs = menuSize m >>= mradiobutton' m cs
-- Radio -----------------------------------------------

--data Radio = TkRad String GUIInfo (IORef [String])

radio :: [Radiobutton] -> GUI Radio
radio ms = withGUIInfo $ T.radio ms

mradio :: [MRadiobutton] -> GUI Radio
mradio ms = withGUIInfo $ T.mradio ms

appendRadio :: Radio -> Radiobutton -> GUI ()
appendRadio rad r = liftIO $ T.appendRadio rad r

removeRadio :: Radio -> Radiobutton -> GUI ()
removeRadio rad r = liftIO $ T.removeRadio rad r

appendMRadio :: Radio -> MRadiobutton -> GUI ()
appendMRadio rad r = liftIO $ T.appendRadio rad r

removeMRadio :: Radio -> MRadiobutton -> GUI ()
removeMRadio rad r = liftIO $ T.removeRadio rad r

setRadio :: Radio -> Int -> GUI ()
setRadio r x = liftIO $ T.setRadio r x
    
getRadio :: Radio -> GUI Int
getRadio rad = liftIO $ T.getRadio rad

setRadio' :: Radio -> WTag -> GUI ()
setRadio' rad w = liftIO $ T.setRadio' rad w

getRadio' :: Radio -> GUI WTag
getRadio' = liftIO . T.getRadio'


-- Radiobutton ---------------------------------
 
--type Radiobutton  = PWidget RB
--data RB           = TkRB


instance Has_activebackground	 RB
instance Has_activeforeground	 RB
instance Has_anchor		 RB
instance Has_background		 RB
instance Has_bitmap		 RB
instance Has_borderwidth	 RB
instance Has_command		 RB
instance Has_cursor		 RB
instance Has_font		 RB
instance Has_foreground		 RB
instance Has_height		 RB
instance Has_highlightbackground RB
instance Has_highlightcolor	 RB
instance Has_highlightthickness	 RB
instance Has_indicatoron	 RB
instance Has_justify		 RB
instance Has_active_state	 RB
instance Has_padx		 RB
instance Has_pady		 RB
instance Has_relief		 RB
instance Has_selectcolor	 RB
instance Has_takefocus		 RB
instance Has_text		 RB
instance Has_underline		 RB
instance Has_width		 RB
instance Has_wraplength		 RB

radiobutton' :: WPath -> [Conf RB] -> GUI Radiobutton
radiobutton' nm = mkWidget $ T.radiobutton' nm

radiobutton :: Window -> [Conf RB] -> GUI Radiobutton
radiobutton w c = liftIO $ T.radiobutton w (fromConf c) 

-- Checkbutton --------------------------------
 
--type Checkbutton = PWidget Che
--data Che         = TkChe


instance Has_activebackground	 Che
instance Has_activeforeground	 Che
instance Has_anchor		 Che
instance Has_background		 Che
instance Has_bitmap		 Che
instance Has_borderwidth	 Che
instance Has_command		 Che
instance Has_cursor		 Che
instance Has_font		 Che
instance Has_foreground		 Che
instance Has_height		 Che
instance Has_highlightbackground Che
instance Has_highlightcolor	 Che
instance Has_highlightthickness	 Che
instance Has_indicatoron	 Che
instance Has_justify		 Che
instance Has_active_state	 Che
instance Has_padx		 Che
instance Has_pady		 Che
instance Has_relief		 Che
instance Has_selectcolor	 Che
instance Has_takefocus		 Che
instance Has_text		 Che
instance Has_underline		 Che
instance Has_width		 Che
instance Has_wraplength		 Che

checkbutton' :: WPath -> [Conf Che] -> GUI Checkbutton
checkbutton' nm = mkWidget $ T.checkbutton' nm 

checkbutton :: Window -> [Conf Che] -> GUI Checkbutton
checkbutton w cs = liftIO $ T.checkbutton w (fromConf cs)

getCheck :: Checkbutton -> GUI Bool
getCheck w = liftIO $ T.getCheck w
 
setCheck :: Checkbutton -> Bool -> GUI ()
setCheck w b = liftIO $ T.setCheck w b
 
varCheck :: Checkbutton -> String
varCheck w = wpath w

-- Button  ------------------------------------
 
--type Button  = PWidget But
--data But     = TkBut

button' :: WPath -> [Conf But] -> GUI Button
button' nm = mkWidget $ T.button' nm 

button :: Window -> [Conf But] -> GUI Button
button w cs = liftIO $ T.button w (fromConf cs) 

instance Has_activebackground	 But
instance Has_activeforeground	 But
instance Has_anchor		 But
instance Has_background		 But
instance Has_bitmap		 But
instance Has_borderwidth	 But
instance Has_command		 But
instance Has_cursor		 But
instance Has_font		 But
instance Has_foreground		 But
instance Has_height		 But
instance Has_highlightbackground But
instance Has_highlightcolor	 But
instance Has_highlightthickness	 But
instance Has_justify		 But
instance Has_active_state	 But
instance Has_padx		 But
instance Has_pady		 But
instance Has_relief		 But
instance Has_takefocus		 But
instance Has_text		 But
instance Has_underline		 But
instance Has_width		 But
instance Has_wraplength		 But

-- Frame -----------------------------------------------
 
--type Frame = WWidget Fra
--data Fra   = TkFra
 
instance Has_height		 Fra
instance Has_borderwidth	 Fra
instance Has_cursor		 Fra
instance Has_relief		 Fra
instance Has_width		 Fra
instance Has_highlightbackground Fra
instance Has_highlightcolor	 Fra
instance Has_highlightthickness	 Fra
instance Has_takefocus		 Fra
instance Has_background		 Fra

 
frame' :: WPath -> [Conf Fra] -> GUI Frame
frame' nm  = mkWidget $ T.frame' nm

frame :: Window -> [Conf Fra] -> GUI Frame
frame w cs = liftIO $ T.frame w (fromConf cs)


-- Label -----------------------------------------------
 
--type Label = PWidget Lab
--data Lab   = TkLab


instance Has_anchor		 Lab
instance Has_background		 Lab
instance Has_bitmap		 Lab
instance Has_borderwidth	 Lab
instance Has_cursor		 Lab
instance Has_font		 Lab
instance Has_foreground		 Lab
instance Has_height		 Lab
instance Has_highlightbackground Lab
instance Has_highlightcolor	 Lab
instance Has_highlightthickness	 Lab
instance Has_justify		 Lab
instance Has_padx		 Lab
instance Has_pady		 Lab
instance Has_relief		 Lab
instance Has_takefocus		 Lab
instance Has_text		 Lab
instance Has_underline		 Lab
instance Has_width		 Lab
instance Has_wraplength		 Lab
 
label' :: WPath -> [Conf Lab] -> GUI Label
label' nm = mkWidget $ T.label' nm

label :: Window -> [Conf Lab] -> GUI Label
label nm cs = liftIO $ T.label nm (fromConf cs)

-- Scale -----------------------------------------------

--type Scale = PWidget Sca
--data Sca = TkSca


instance Has_activeforeground	 Sca
instance Has_background		 Sca
instance Has_borderwidth	 Sca
instance Has_command		 Sca
instance Has_cursor		 Sca
instance Has_font		 Sca
instance Has_foreground		 Sca
instance Has_highlightbackground Sca
instance Has_highlightcolor	 Sca
instance Has_highlightthickness	 Sca
instance Has_hor_orient		 Sca
instance Has_active_state	 Sca
instance Has_relief		 Sca
instance Has_sca_from 		 Sca
instance Has_sca_length 	 Sca
instance Has_sca_to 		 Sca
instance Has_sliderlength 	 Sca
instance Has_takefocus		 Sca
instance Has_tickinterval 	 Sca
instance Has_troughcolor 	 Sca
instance Has_wgt_label		 Sca
instance Has_width		 Sca

vscale', hscale' :: WPath -> [Conf Sca] -> GUI Scale
vscale' w = mkWidget $ T.vscale' w 
hscale' w = mkWidget $ T.hscale' w

vscale,hscale :: Window -> [Conf Sca] -> GUI Scale
vscale w cs = liftIO $ T.vscale w $ fromConf cs
hscale w cs = liftIO $ T.hscale w $ fromConf cs

getScale :: Scale -> GUI Int
getScale w = liftIO $ T.getScale w

setScale :: Scale -> Int -> GUI ()
setScale w i = liftIO $ T.setScale w i

-- Scrollable Widget Class -----------------------------

class ScrollableX w
class ScrollableY w

xview :: ScrollableX b => Widget a b -> GUI (Double,Double)
xMoveTo :: ScrollableX b => Widget a b -> Double -> GUI ()
xScroll :: ScrollableX b => Widget a b -> ScrollUnit -> GUI ()

xview w = liftIO $ T.xview_ w
xMoveTo w x = liftIO $ T.xMoveTo_ w x
xScroll w s = liftIO $ T.xScroll_ w s

yview :: ScrollableY b => Widget a b -> GUI (Double,Double)
yMoveTo :: ScrollableY b => Widget a b -> Double -> GUI ()
yScroll :: ScrollableY b => Widget a b -> ScrollUnit -> GUI ()

yview w = liftIO $ T.yview_ w
yMoveTo w x = liftIO $ T.yMoveTo_ w x
yScroll w s = liftIO $ T.yScroll_ w s

-- Scrollbar -------------------------------------------
 
--type Scrollbar = WWidget Scr
--data Scr       = TkScr
 
instance Has_width		 Scr
instance Has_highlightbackground Scr
instance Has_highlightcolor	 Scr
instance Has_highlightthickness	 Scr
instance Has_takefocus		 Scr
instance Has_borderwidth	 Scr
instance Has_cursor		 Scr
instance Has_relief		 Scr
instance Has_background		 Scr
instance Has_hor_orient		 Scr

scrollbar :: Window -> [Conf Scr] -> GUI Scrollbar
scrollbar w cs = liftIO $ T.scrollbar w (fromConf cs)

scrollbar' :: WPath -> [Conf Scr] -> GUI Scrollbar
scrollbar' nm = mkWidget $ T.scrollbar' nm

vscroll' :: ScrollableY w => WPath -> PWidget w -> [Conf Scr] -> GUI Scrollbar
vscroll' nm w cs = liftIO $ T.vscroll' nm w (fromConf cs)

hscroll' :: ScrollableX w => WPath -> PWidget w -> [Conf Scr] -> GUI Scrollbar
hscroll' nm w cs = liftIO $ T.hscroll' nm w (fromConf cs)


vscroll :: ScrollableY w => PWidget w -> [Conf Scr] -> GUI Scrollbar
hscroll :: ScrollableX w => PWidget w -> [Conf Scr] -> GUI Scrollbar
vscroll p cs = liftIO $ T.vscroll p (fromConf cs)
hscroll p cs = liftIO $ T.hscroll p (fromConf cs)

-- Scanning -------------------------------------------

class Scan w 

scanMark :: Scan w => Widget a w -> Int -> Int -> GUI ()
scanMark w x y = liftIO $ T.scanMark w x y

scanDrag :: Scan w => Widget a w -> Int -> Int -> GUI ()
scanDrag w x y = liftIO $ T.scanDrag w x y

-- Listbox ---------------------------------------------

--type Listbox = PWidget Lis
--data Lis     = TkLis 

instance Has_background		 Lis
instance Has_foreground		 Lis
instance Has_font		 Lis
instance Has_borderwidth	 Lis
instance Has_cursor		 Lis
instance Has_relief		 Lis
instance Has_width		 Lis
instance Has_highlightbackground Lis
instance Has_highlightcolor	 Lis
instance Has_highlightthickness	 Lis
instance Has_takefocus		 Lis
instance Has_height		 Lis
instance Has_selectbackground	 Lis
instance Has_selectforeground	 Lis
instance Has_selectborderwidth	 Lis
instance Has_selectmode 	 Lis
instance Has_setgrid		 Lis
instance ScrollableX		 Lis
instance ScrollableY		 Lis
instance Scan			 Lis

listbox' :: WPath -> [Conf Lis] -> GUI Listbox
listbox' nm = mkWidget $ T.listbox' nm

listbox :: Window -> [Conf Lis] -> GUI Listbox
listbox w cs = liftIO $ T.listbox w (fromConf cs)

getListboxSelection :: Listbox -> GUI [Int]
getListboxSelection w = liftIO $ T.getListboxSelection w

getListboxEntries :: Listbox -> LIndex -> LIndex -> GUI [String]
getListboxEntries l x y = liftIO $ T.getListboxEntries l x y

getListboxSize :: Listbox -> GUI Int
getListboxSize l = liftIO $ T.getListboxSize l

listboxMoveToSee :: Listbox -> LIndex -> GUI ()
listboxMoveToSee l n = liftIO $ T.listboxMoveToSee l n

insertListbox :: Listbox -> LIndex -> [String] -> GUI ()
insertListbox l x xs = liftIO $ T.insertListbox l x xs

deleteListbox :: Listbox -> LIndex -> LIndex -> GUI ()
deleteListbox l x1 x2 = liftIO $ T.deleteListbox l x1 x2

resetListbox :: Listbox -> [String] -> GUI ()
resetListbox w ls = liftIO $ T.resetListbox w ls

addListboxSelection :: Listbox -> LIndex -> LIndex -> GUI ()
addListboxSelection l x1 x2 = liftIO $ T.addListboxSelection l x1 x2

clearListboxSelection :: Listbox -> LIndex -> LIndex -> GUI ()
clearListboxSelection l x1 x2 = liftIO $ T.clearListboxSelection l x1 x2

setListboxSelectionAnchor :: Listbox -> LIndex -> GUI ()
setListboxSelectionAnchor l x = liftIO $ T.setListboxSelectionAnchor l x

	
-- Canvas ----------------------------------------------
 
--type Canvas  = WWidget Can
--data Can     = TkCan
 
instance Has_background		 Can
instance Has_borderwidth	 Can
instance Has_cursor		 Can
instance Has_height		 Can
instance Has_highlightbackground Can
instance Has_highlightcolor	 Can
instance Has_highlightthickness	 Can
instance Has_relief		 Can
instance Has_scrollregion	 Can
instance Has_takefocus		 Can
instance Has_width		 Can
instance Scan 			 Can 
instance ScrollableX		 Can
instance ScrollableY		 Can

canvas' :: WPath -> [Conf Can] -> GUI Canvas
canvas' nm  = mkWidget $ T.canvas' nm

canvas  :: Window -> [Conf Can] -> GUI Canvas
canvas w cs = liftIO $ T.canvas w (fromConf cs)

citem_canvas :: CWidget a -> GUI Canvas
citem_canvas = liftIO . T.citem_canvas


moveObject :: CWidget w -> (Int,Int) -> GUI ()
moveObject c x = liftIO $ T.moveObject c x

removeObject :: CWidget w -> GUI ()
removeObject = liftIO . T.removeObject

scaleObject :: CWidget a -> (Int,Int) -> Double -> Double -> GUI ()
scaleObject c x a b = liftIO $ T.scaleObject c x a b 

lowerObject :: CWidget w -> Maybe String -> GUI ()
lowerObject c mb = liftIO $ T.lowerObject c mb

raiseObject :: CWidget w -> Maybe String -> GUI ()
raiseObject c mb = liftIO $ T.raiseObject c mb

bboxObjects :: [CWidget a] -> GUI (Int,Int,Int,Int)
bboxObjects cs = liftIO $ T.bboxObjects cs

getCoords :: CWidget w -> GUI [(Int,Int)]
getCoords c = liftIO $ T.getCoords c

setCoords :: CWidget w -> [(Int,Int)] -> GUI ()
setCoords c x = liftIO $ T.setCoords c x
 


-- CImage -------------------------------------------------------

--type CImage = CWidget CIm
--data CIm = TkCIm

instance Has_anchor		CIm
instance Has_image		CIm
instance Has_tags		CIm

cimage :: Canvas -> Coord -> [Conf CIm] -> GUI CImage
cimage c crd cs = liftIO $ T.cimage c crd $ fromConf cs

cimage' :: Canvas -> CCoord -> [Conf CIm] -> GUI CImage
cimage' c crd cs = liftIO $ T.cimage' c crd $ fromConf cs

-- COval -------------------------------------------------------
 
--type COval = CWidget COva
--data COva  = TkCOva
 
instance Has_fill	COva
instance Has_outline	COva
instance Has_tags	COva
instance Has_width	COva

coval :: Canvas -> Coord -> Coord -> [Conf COva] -> GUI COval
coval c crd1 crd2 cs = liftIO $ T.coval c crd1 crd2 $ fromConf cs

coval' :: Canvas -> CCoord -> CCoord -> [Conf COva] -> GUI COval
coval' c crd1 crd2 cs = liftIO $ T.coval' c crd1 crd2 $ fromConf cs


-- CLine ------------------------------------------------------
 
--type CLine = CWidget CLin
--data CLin  = TkCLin
 
instance Has_fill	CLin
instance Has_tags	CLin
instance Has_width	CLin

cline :: Canvas -> [Coord] -> [Conf CLin] -> GUI CLine
cline c crds cs = liftIO $ T.cline c crds $ fromConf cs
 
cline' :: Canvas -> [CCoord] -> [Conf CLin] -> GUI CLine
cline' c crds cs = liftIO $ T.cline' c crds $ fromConf cs

-- CRectangle --------------------------------------------
 
--type CRectangle = CWidget CRec
--data CRec       = TkCRec
 
instance Has_fill	CRec
instance Has_outline	CRec
instance Has_tags	CRec
instance Has_width	CRec


crectangle :: Canvas -> Coord -> Coord -> [Conf CRec] -> GUI CRectangle
crectangle c crd1 crd2 cs = liftIO $ T.crectangle c crd1 crd2 $ fromConf cs

crectangle' :: Canvas -> CCoord -> CCoord -> [Conf CRec] -> GUI CRectangle
crectangle' c crd1 crd2 cs = liftIO $ T.crectangle' c crd1 crd2 $ fromConf cs
 
-- CArc --------------------------------------------------
 
--type CArc = CWidget CAr
--data CAr  = TkCAr
 
instance Has_fill	CAr
instance Has_outline	CAr
instance Has_tags	CAr
instance Has_width	CAr

carc :: Canvas -> Coord -> Coord -> [Conf CAr] -> GUI CArc
carc c crd1 crd2 cs = liftIO $ T.carc c crd1 crd2 $ fromConf cs
 
carc' :: Canvas -> CCoord -> CCoord -> [Conf CAr] -> GUI CArc
carc' c crd1 crd2 cs = liftIO $ T.carc' c crd1 crd2 $ fromConf cs
-- CPoly -------------------------------------------------
 
--type CPoly = CWidget CPol
--data CPol  = TkCPol
 
instance Has_fill	CPol
instance Has_outline	CPol
instance Has_tags	CPol
instance Has_width	CPol


cpoly :: Canvas -> [Coord] -> [Conf CPol] -> GUI CPoly
cpoly c crds cs = liftIO $ T.cpoly c crds $ fromConf cs
 
cpoly' :: Canvas -> [CCoord] -> [Conf CPol] -> GUI CPoly
cpoly' c crds cs = liftIO $ T.cpoly' c crds $ fromConf cs
 
-- CText -----------------------------------------------------
 
--type CText = CWidget CTex
--data CTex  = TkCTex
 
instance Has_anchor	CTex
instance Has_fill	CTex
instance Has_font	CTex
instance Has_justify	CTex
instance Has_tags	CTex
instance Has_text	CTex
instance Has_width	CTex

ctext :: Canvas -> Coord -> [Conf CTex] -> GUI CText
ctext c crd cs = liftIO $ T.ctext c crd $ fromConf cs
 
ctext' :: Canvas -> CCoord -> [Conf CTex] -> GUI CText
ctext' c crd cs = liftIO $ T.ctext' c crd $ fromConf cs

-- CBitmap ---------------------------------------------------
 
--type CBitmap = CWidget CBit
--data CBit    = TkCBit
 
instance Has_selectbackground	CBit
instance Has_selectforeground	CBit
instance Has_selectborderwidth	CBit
instance Has_foreground		CBit
instance Has_justify		CBit
instance Has_anchor		CBit
instance Has_bitmap		CBit
instance Has_tags	        CBit

cbitmap :: Canvas -> Coord -> [Conf CBit] -> GUI CBitmap
cbitmap c crd cs = liftIO $ T.cbitmap c crd $ fromConf cs

cbitmap' :: Canvas -> CCoord -> [Conf CBit] -> GUI CBitmap
cbitmap' c crd cs = liftIO $ T.cbitmap' c crd $ fromConf cs

-- CWindow ---------------------------------------------------
 
--type CWindow = CWidget CWin
--data CWin = TkCWin
 
instance Has_anchor  CWin
instance Has_justify CWin
instance Has_tags    CWin
instance Has_width CWin
instance Has_height CWin

cwindow :: Canvas -> Coord -> PWidget w -> [Conf CWin] -> GUI CWindow
cwindow c crd w cs = liftIO $ T.cwindow c crd w $ fromConf cs

cwindow' :: Canvas -> CCoord -> PWidget w -> [Conf CWin] -> GUI CWindow
cwindow' c crd w cs = liftIO $ T.cwindow' c crd w $ fromConf cs

-- Entry -----------------------------------------------

--type Entry = WWidget Ent
--data Ent = TkEnt

instance Has_background		 Ent
instance Has_borderwidth	 Ent
instance Has_cursor		 Ent
instance Has_ent_show		 Ent
instance Has_font		 Ent
instance Has_foreground		 Ent
instance Has_highlightbackground Ent
instance Has_highlightcolor	 Ent
instance Has_highlightthickness	 Ent
instance Has_justify		 Ent
instance Has_active_state	 Ent
instance Has_relief		 Ent
instance Has_takefocus		 Ent
instance Has_width		 Ent
instance Scan			 Ent
instance ScrollableX		 Ent



entry' :: WPath -> [Conf Ent] -> GUI Entry
entry :: Window -> [Conf Ent] -> GUI Entry

getEntry :: Entry -> GUI String
setEntry :: Entry -> String -> GUI()
insertEntry :: Entry -> EIndex -> String -> GUI ()
deleteEntry :: Entry -> EIndex -> EIndex -> GUI ()

setICursor :: Entry -> EIndex -> GUI ()

clearEntrySelection :: Entry -> GUI ()
setEntrySelectionAnchor :: Entry -> EIndex -> GUI ()
isEntrySelected :: Entry -> GUI Bool
setEntrySelection :: Entry -> EIndex -> EIndex -> GUI ()
adjustEntrySelection :: Entry -> EIndex -> GUI ()
setToEntrySelection :: Entry -> EIndex -> GUI ()

entry' w = mkWidget $ T.entry' w
entry w cs = liftIO $ T.entry w $ fromConf cs

getEntry = liftIO . T.getEntry
setEntry e s = liftIO $ T.setEntry e s
insertEntry e i s = liftIO $ T.insertEntry e i s
deleteEntry e i i2 = liftIO $ T.deleteEntry e i i2

setICursor e ie = liftIO $ T.setICursor e ie

clearEntrySelection = liftIO . T.clearEntrySelection
setEntrySelectionAnchor e i = liftIO $ T.setEntrySelectionAnchor e i
isEntrySelected e = liftIO $ T.isEntrySelected e
setEntrySelection e i1 i2 = liftIO $ T.setEntrySelection e i1 i2
adjustEntrySelection e ei = liftIO $ T.adjustEntrySelection e ei
setToEntrySelection e ei = liftIO $ T.setToEntrySelection e ei
  

-- Edit ------------------------------------------------
 
--type Edit = WWidget Edi
--data Edi  = Edi

instance Has_background		 Edi
instance Has_borderwidth	 Edi
instance Has_cursor		 Edi
instance Has_font		 Edi
instance Has_foreground		 Edi
instance Has_height		 Edi
instance Has_highlightbackground Edi
instance Has_highlightcolor	 Edi
instance Has_highlightthickness	 Edi
instance Has_active_state	 Edi
instance Has_padx		 Edi
instance Has_pady		 Edi
instance Has_relief		 Edi
instance Has_selectbackground	 Edi
instance Has_selectborderwidth	 Edi
instance Has_selectforeground	 Edi
instance Has_setgrid		 Edi
instance Has_takefocus		 Edi
instance Has_width		 Edi
instance Has_wrap		 Edi
instance Scan			 Edi 
instance ScrollableX		 Edi
instance ScrollableY		 Edi

saveEdit :: Edit -> FilePath -> GUI ()
saveEdit e f = do
 s <- getEdit e
 proc $ writeFile f s

loadEdit :: Edit -> FilePath -> GUI ()
loadEdit e f = do
 s <- proc $ readFile f
 resetEdit e s


edit' :: WPath -> [Conf Edi] -> GUI Edit
edit :: Window -> [Conf Edi] -> GUI Edit

eqTIndex,ltTIndex,gtTIndex :: Edit -> TIndex -> TIndex 
                           -> GUI Bool
cmpTIndex :: Edit -> TIndex -> TIndex -> GUI Ordering

lineAreaEdit :: Edit -> TIndex -> GUI (Int,Int,Int,Int,Int)


getEdit :: Edit -> GUI String

getFromTo :: Edit -> TIndex -> TIndex -> GUI String

fromTIndex :: Edit -> TIndex -> GUI (Maybe (Int,Int))

insertEdit :: Edit -> TIndex -> String -> GUI ()
deleteEdit :: Edit -> TIndex -> TIndex -> GUI ()   
resetEdit :: Edit -> String -> GUI ()

searchEdit :: Edit 
	       -> Bool -- forward if True (back otherwise) 
	       -> Bool -- ignore case if True
	       -> Bool -- treat pattern as regexp
	       -> String -- pattern
	       -> TIndex -- start at
	       -> TIndex -- stop at
               -> GUI (Maybe ((Int,Int),Int))
      
editMoveTo :: Edit -> TIndex -> GUI ()

insertEditTagged :: Edit -> TIndex -> String -> [TagId] 
                 -> GUI ()

edit' w = mkWidget $ T.edit' w
edit w cs = liftIO $ T.edit w $ fromConf cs
eqTIndex a b c = liftIO $ T.eqTIndex a b c
ltTIndex a b c = liftIO $ T.ltTIndex a b c
gtTIndex a b c = liftIO $ T.gtTIndex a b c
cmpTIndex a b c = liftIO $ T.cmpTIndex a b c
lineAreaEdit a b = liftIO $ T.lineAreaEdit a b

getEdit a = liftIO $ T.getEdit a
getFromTo a b c = liftIO $ T.getFromTo a b c
fromTIndex a b = liftIO $ T.fromTIndex a b
insertEdit a b c = liftIO $ T.insertEdit a b c
deleteEdit a b c = liftIO $ T.deleteEdit a b c
resetEdit a b = liftIO $ T.resetEdit a b
searchEdit t a b c d e f = liftIO $ T.searchEdit t a b c d e f 
editMoveTo t e = liftIO $ T.editMoveTo t e
insertEditTagged t i s x = liftIO $ T.insertEditTagged t i s x


cutClipboard :: Edit -> GUI ()
cutClipboard e = liftIO $ T.cutClipboard e
copyClipboard :: Edit -> GUI ()
copyClipboard e = liftIO $ T.copyClipboard e
pasteClipboard :: Edit -> GUI ()
pasteClipboard e = liftIO $ T.pasteClipboard e
clearSelEdit :: Edit -> GUI ()
clearSelEdit e = liftIO $ T.clearSelEdit e

-- Mark ------------------------------------------------

--data Mark = Mark {markId :: ! MarkId,markEdit :: ! Edit}
--type MarkId = String

mark' :: Edit -> MarkId -> TIndex -> GUI Mark
mark' e s t = liftIO $ T.mark' e s t

mark :: Edit -> TIndex -> GUI Mark
mark e t = liftIO $ T.mark e t

setMark :: Mark -> TIndex -> GUI ()
setMark m t = liftIO $ T.setMark m t

getMarkPos :: Mark -> GUI (Maybe (Int,Int))
getMarkPos m = liftIO $ T.getMarkPos m

removeMark :: Mark -> GUI ()
removeMark m = liftIO $ T.removeMark m

setMarkGravity :: Mark -> Gravity -> GUI ()
setMarkGravity m g = liftIO $ T.setMarkGravity m g

getMarkGravity :: Mark -> GUI Gravity
getMarkGravity m = liftIO $ T.getMarkGravity m 

getAllMarks :: Edit -> GUI [Mark]
getAllMarks e = liftIO $ T.getAllMarks e

--getMark :: Edit -> MarkId -> Mark

previousMark :: Edit -> TIndex -> GUI Mark
previousMark e t = liftIO $ T.previousMark e t

nextMark :: Edit -> TIndex -> GUI Mark
nextMark e t = liftIO $ T.nextMark e t

--insertionMark :: Edit -> Mark
--currentMark :: Edit -> Mark


-- Embedded Text Windows -------------------------------

--type Embedded = EWidget Ew
--data Ew = Ew

instance Has_padx Ew
instance Has_pady Ew

stretch :: Bool -> Conf Ew
stretch b = "stretch" %% show b

align :: Align -> Conf Ew
align a = "align" %% showAlign a

data Align = AlignTop | AlignCenter | AlignBottom | AlignBaseLine
 deriving Eq

showAlign AlignTop = "top"
showAlign AlignCenter = "center"
showAlign AlignBottom = "bottom"
showAlign AlignBaseLine = "baseline"

embedded' :: Edit -> WPath -> TIndex -> [Conf Ew] -> GUI Embedded
embedded' e pth indx cs = liftIO $ T.embedded' e pth indx (fromConf cs)

embedded :: Edit -> PWidget a' -> TIndex -> [Conf Ew] -> GUI Embedded
embedded e w indx cs = embedded' e (wpath w) indx cs

getAllEmbedded :: Edit -> GUI [WPath]
getAllEmbedded e = liftIO $ T.getAllEmbedded e

-- Tag -------------------------------------------------
 
--type Tag = TWidget Tg
--data Tg  = TkTag

instance Has_background	 Tg
instance Has_borderwidth Tg
instance Has_font	 Tg
instance Has_foreground	 Tg
instance Has_justify     Tg
instance Has_relief      Tg
instance Has_underline   Tg
instance Has_wrap 	 Tg

tag' :: Edit -> TagId -> [TIndex] -> [Conf Tg] -> GUI Tag
tag' w ti indx cs = liftIO $ T.tag' w ti indx (fromConf cs)

tag :: Edit -> [TIndex] -> [Conf Tg] -> GUI Tag
tag w xs cs = liftIO $ T.tag w xs (fromConf cs)

putPosTag :: Edit -> TIndex -> String -> [Conf Tg] -> GUI Tag
putPosTag e t s c = liftIO $ T.putPosTag e t s (fromConf c)

setWithTags :: Edit -> TagId -> [TIndex] -> GUI ()
setWithTags e t xs = liftIO $ T.setWithTags e t xs

tagEdit :: Tag -> GUI Edit
tagEdit w = liftIO $ T.tagEdit w

lowerTag :: Tag -> Maybe TagId -> GUI ()
lowerTag tg mb = liftIO $ T.lowerTag tg mb

raiseTag :: Tag -> Maybe TagId -> GUI ()
raiseTag tg mb = liftIO $ T.raiseTag tg mb
 
getAllTags :: Edit -> GUI [TagId]
getAllTags edi = liftIO $ T.getAllTags edi

getTagsAt :: Edit -> TIndex -> GUI [TagId]
getTagsAt edi t = liftIO $ T.getTagsAt edi t

tagRemove :: Tag -> [TIndex] -> GUI ()
tagRemove tg ts = liftIO $ T.tagRemove tg ts

tagRanges :: Tag -> GUI [((Int,Int),(Int,Int))]
tagRanges tg = liftIO $ T.tagRanges tg

tagNextRange :: Tag -> TIndex -> TIndex 
	     -> GUI (Maybe ((Int,Int),(Int,Int)))   
tagNextRange t t1 t2 = liftIO $ T.tagNextRange t t1 t2

tagPrevRange :: Tag -> TIndex -> TIndex 
	     -> GUI (Maybe ((Int,Int),(Int,Int)))   
tagPrevRange t t1 t2 = liftIO $ T.tagPrevRange t t1 t2

tagText :: Tag -> GUI [String]
tagText t = liftIO $ T.tagText t

selectionTag :: Edit -> GUI Tag
selectionTag w = liftIO $ T.selectionTag w

mkDialog :: a -> GUIRef (Maybe a) -> Window -> GUI a
mkDialog def ref w = do 
  trapDeleteWindow w (writeState ref $ Just def)
  tcl_eventUntil (fmap isJust $ readState ref)
  mb <- readState ref
  destroy w
  return $ maybe def id mb