Gustaf Neumann wrote:
Catherine, you seem to be quite happy with your Tk integration. Can you post a small but complete introductory example. Do you use Tk features like "-command"?
Yes I do, as well as -variable -textvariable and bindings. I use [incr tk] as well (for which I have to help the Xotcl widgets tree to correspond to the actual tk tree).
The aim was to be able to keep the actual tk creation/layout code that you can borrow in books, ftp sites, application examples, ... it's very important to me to keep such examples usable without any adaptation.
Another aim is to be able to have a memory image of the Tk widgets state, for I want my application to be persistent, or just to be able to edit or clone objects with their tk widgets.
A 3rd goal is to keep advantages of the composite pattern. For instance, as the general idea of the application (very influenced by the Self environment although much more modest) is to have a graphical handle for application objects (I don't mean all XOtcl objects, but application level ones), I need to be able to find this object from a menu which may be posted from any location in the GUI.
So I will try to summarize a small example - it's impossible to make it complete though, there is too much code and it's not ready for distribution - at all.
# ----------------------------------------------------------------------------- # composite pattern
[... same as in the Xotcl paper...] Composite AbstractNode AbstractNode filter compositeFilter AbstractNode abstract instproc iterate v
# ----------------------------------------------------------------------------- # GraphObject is the general graphical object class
GraphObject instproc draw args { [...]
# generic frame for all graphical objects
set frame ${object_name}_frame widgets build $frame { frame $path -borderwidth 2 -relief sunken } widgets layout $frame { pack $path -expand 1 -fill both }
# location for custom widgets (as in [incr tk]) [self] instvar childsite set childsite ${frame}::widgets [...] }
# ----------------------------------------------------------------------------- # example: a field object # (containing an entry widget and a button)
Class Field -superclass GraphObject
Field instproc init args { [...] [self] draw }
Field instproc draw args { next
[self] instvar childsite set path [$childsite set path] widgets build $childsite { frame $path } widgets layout $childsite { pack $path -expand 1 -fill both }
# ------------------------------------------------------------- # 1st tk widget: an entry
[self] instvar data # datavar contains the name of a global variable set datavar [$data set datavar] widgets build ${childsite}::datafield { entry $path.datafield -textvariable $datavar } widgets layout ${childsite}::datafield { pack $path.datafield -side top -expand 1 -fill x } ::bind $path.datafield <Return> { set object [names object %W] # MVC protocol [$object set data] update }
# ------------------------------------------------------------- # 2nd tk widget: a button
widgets build ${childsite}::doit { button $path.doit -command [list [self] do_something] -text "DoIt" } widgets layout ${childsite}::doit { pack $path.doit -side left }
# -------------------------------------------------------------
# connect all widgets to the current graphical object $childsite iterate setObjectName [self]
# bind button3 to a "meta" menu for all the widgets hierarchy $childsite iterate bindMetaButton
}
# ----------------------------------------------------------------------------- # Widgets
Class Widgets -superclass AbstractNode Class Widget -superclass Widgets
Object widgets
widgets proc build {widget body} {
# XOtcl Widget creation uplevel Widget $widget
# actual tk creation if [catch {set path [uplevel $body]} err] { global errorInfo puts stderr "widgets (build) err:$err\n$errorInfo" } else { [self] setwidget $widget $path } }
widgets proc setwidget {widget path} {
# data structure initializations $widget set path $path $widget set type [string tolower [winfo class $path]] $widget set options [[self] buildoptions $path] }
widgets proc layout {widget body} {
# actual layout if [catch {uplevel $body} err] { global errorInfo puts stderr "Widget (layout) err:$err\n$errorInfo" } else {
# data structure initializations... $widget set layout [[self] buildlayout [$widget set path]] } }
# ----------------------------------------------------------------------------- # visitors for widgets hierarchy
Class TreeVisitor TreeVisitor abstract instproc visit objectName
# menu for graphical objects
TreeVisitor bindMetaButton bindMetaButton proc visit args { set node [lindex $args 0] set path [$node set path] if [::winfo exists $path] { ::bind $path <ButtonPress-3> { set object [names object %W] ${object}::menu display $object [$object set commands] %x %y %X %Y %W break } } }
TreeVisitor setObjectName setObjectName proc visit args { set node [lindex $args 0] set obj [lindex $args 1] $node instvar object if { $obj != "" } { set object $obj } if { [names object [$node set path]] == "" } { names object [$node set path] $obj } }
# ----------------------------------------------------------------------------- # names: name server (alias, graphical objects, widgets,...)
Object names
# bind graphical objects and tk widgets names proc object {widget {object ""}} { [self] instvar objects if {$object == ""} { if [info exists objects($widget)] { [self] set objects($widget) } } else { [self] set objects($widget) $object } }
-- Catherine Letondal -- Pasteur Institute Computing Center