[Xotcl] Re: [Xotcl] Re: [Xotcl] Widgets

From: Catherine Letondal <letondal_at_pasteur.fr>
Date: Tue, 06 Feb 2001 16:15:56 +0100

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