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]