Posted to tcl by apw at Sun Sep 30 08:13:04 GMT 2007view pretty

::itcl::struct ::ntk::classes::base {
    public variable parent [list]
    public variable children [list]
    public variable manager [list]
    public variable redraw [list]
    public variable destroy [list]
    public variable update 1
    public variable toplevel 0
    public variable removeFromManager [list]
    public variable renderTreeData [list]
    public variable bg [list]
    public variable obj [list]
    public variable path [list]

    public option -reqwidth 0
    public option -reqheight 0
    public option -width 0
    public option -height 0
    public option -x 0
    public option -y 0
    public option -rotate 0
    public option -buttonrelease [list]
    public option -keypress [list]
    public option -keyrelease [list]
    public option -motion [list]

    constructor {path width height obj parent {x 0} {y 0}
            {toplevel 0} {bg {}}} {
        configure -reqwidth $width
        configure -reqheight $height
        configure -width $width
        configure -height $height
        configure -x $x
        configure -y $y
        configure -obj $obj
        configure -parent $parent
        configure -toplevel $toplevel
        configure -bg $bg
        configure -path $path
    }
    public method getValue {what} {
        if {![info exists $what]} {
            return -code error "no such variable $what"
        }
        return [set $what]
    }
    public method setValue {what value} {
        if {![info exists $what]} {
            return -code error "no such variable $what"
        }
        if {[catch {set $what $value} err]} {
            return -code error $err
        }
        return $value
    }
}

itcl::nwidget ::ntk::classes::window {
    private common cntWindows 0
    private common windows
    component base
    delegate option -reqwidth to base
    delegate option -reqheight to base
    delegate option -width to base
    delegate option -height to base
    delegate option -x to base
    delegate option -y to base
    delegate option -rotate to base
    delegate option -buttonpress to base
    delegate option -buttonrelease to base
    delegate option -keypress to base
    delegate option -keyrelease to base
    delegate method getValue to base
    delegate method setValue to base
    delegate method obj to base as [list getValue obj]

    public proc parent {path} {
puts stderr "path!$path!"
        set parent [string range $path 0 [expr {[string last . $path] - 1}]]
        if {$parent eq ""} {
            return .
        }
        return $parent
    }
    public proc toplevel {path} {
        set i [string first $path 1]
        if {$i < 0} {
            return $path
        }        incr i -1
        return [string range $path 0 $i]
    }
    public method children {w} {
        return [$w getValue children]
    }

    constructor {width height} {
        incr cntWindows
        set path [string trimleft $this :]
        if {[info exists windows($path)]} {
            return -code error "window $this already exists"
        }
        set windows($path) $path
        #
        # Append the child to the parent's window list
        #
        set parent [parent $path]
puts stderr "parent!$parent!$path!"
#       set pchildren [$parent children]
#       lappend pchildren $path
#       $parent children $pchildren
        set obj [megaimage-blank $width $height]
        set base [::ntk::classes::base ::ntk::classes::_win$cntWindows $path $width $height $obj $parent 0 0 0 [list]]
        return $path
    }
}


    public option -buttonpress [list]