Posted to tcl by apw at Sun Sep 30 08:13:04 GMT 2007view raw
- ::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]