module HTk.Textitems.EmbeddedTextWin (
EmbeddedTextWin,
createEmbeddedTextWin,
stretch,
getStretch
) where
import HTk.Kernel.Core
import HTk.Widgets.Editor
import HTk.Components.Index
import Util.Computation
import Events.Synchronized
import HTk.Kernel.Resources
import Events.Destructible
import HTk.Kernel.Geometry
import HTk.Kernel.BaseClasses(Widget)
newtype EmbeddedTextWin = EmbeddedTextWin GUIOBJECT deriving Eq
createEmbeddedTextWin :: (HasIndex Editor i BaseIndex, Widget w) =>
Editor
-> i
-> w
->
[Config EmbeddedTextWin]
-> IO EmbeddedTextWin
createEmbeddedTextWin ed i w cnf =
do
binx <- getBaseIndex ed i
pos <- getBaseIndex ed (binx::BaseIndex)
nm <- getObjectName (toGUIObject w)
wid <- createGUIObject (toGUIObject ed)
(EMBEDDEDTEXTWIN (unparse pos) nm) winMethods
configure (EmbeddedTextWin wid) cnf
where unparse :: Position -> GUIVALUE
unparse (x,y) = toGUIValue (RawData (show x ++ "." ++ show y))
instance GUIObject EmbeddedTextWin where
toGUIObject (EmbeddedTextWin w) = w
cname _ = "EmbeddedTextWin"
instance Destroyable EmbeddedTextWin where
destroy = destroy . toGUIObject
instance Synchronized EmbeddedTextWin where
synchronize = synchronize . toGUIObject
stretch :: Toggle -> Config EmbeddedTextWin
stretch t w = cset w "stretch" t
getStretch :: EmbeddedTextWin -> IO Toggle
getStretch ew = cget ew "stretch"
instance HasIndex Editor EmbeddedTextWin BaseIndex where
getBaseIndex tp win =
synchronize win
(do
name <- getObjectName (toGUIObject win)
case name of
(TextPaneItemName pnm (EmbeddedWindowName wnm)) ->
do
str <- evalTclScript (tkWinIndex pnm wnm)
return (read str))
winMethods =
Methods tkGetTextWinConfig
tkSetTextWinConfigs
tkCreateTextWin
(packCmd voidMethods)
(gridCmd voidMethods)
(destroyCmd voidMethods)
(bindCmd voidMethods)
(unbindCmd voidMethods)
(cleanupCmd defMethods)
tkGetTextWinConfig :: ObjectName -> ConfigID -> TclScript
tkGetTextWinConfig (TextPaneItemName name qual) cid =
[show name ++ " window cget " ++ show qual ++ " -" ++ cid]
tkGetTextWinConfig _ _ = []
tkSetTextWinConfigs :: ObjectName -> [ConfigOption] -> TclScript
tkSetTextWinConfigs (TextPaneItemName name qual) args =
[show name ++ " window configure " ++ show qual ++ " " ++
showConfigs args]
tkSetTextWinConfigs _ _ = []
tkCreateTextWin :: ObjectName -> ObjectKind -> ObjectName -> ObjectID ->
[ConfigOption] -> TclScript
tkCreateTextWin _ (EMBEDDEDTEXTWIN pos wid) (TextPaneItemName name qual) _
confs =
[show name ++ " window create " ++ show pos ++ " -window " ++ show wid]
tkWinIndex :: ObjectName -> ObjectName -> TclScript
tkWinIndex pnm wnm = [show pnm ++ " index " ++ show wnm]