SR Technology WTK Repo
Check-in [c4c1ad43fd]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Moved wtk widgets back to the global namespace
Timelines: family | ancestors | descendants | both | hypnotoad
Files: files | file ages | folders
SHA1:c4c1ad43fd84082173b195b308a722516c128f97
User & Date: seandeelywoods 2013-02-12 15:11:39
Context
2013-02-12
15:13
Ported code to TclOO. Demos all work. Integrated the Odie package to extend TclOO and add extra keywords and to make TclOO more snitlike. check-in: 833107b47e user: seandeelywoods tags: trunk
15:11
Moved wtk widgets back to the global namespace Leaf check-in: c4c1ad43fd user: seandeelywoods tags: hypnotoad
14:57
Merging in changes from trunk check-in: 1cf1e20494 user: seandeelywoods tags: hypnotoad
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to demo.tcl.

63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
  }
}
  
proc swapimages {} {
  switch -- $::image {
    0 {
      set ::image 1; set ::textval "one"
      ::wtk::.d.ib configure -src /images/cameralens1.jpg
    }
    
    1 {
      set ::image 2; set ::textval "two"
      ::wtk::.d.ib configure -src /images/rainbow.gif
    }
    
    2 {
      set ::image 3; set ::textval "three"
      ::wtk::.d.ib configure -src /images/cameralens2.jpg
    }
    
    3 {
      set ::image 0; set ::textval "zero"
      ::wtk::.d.ib configure -src /images/logo.png
    }
  }
}
  
proc selectimg {} {
  switch -- $::textval {
    zero  {
      set ::image 0
      ::wtk::.d.ib configure -src /images/logo.png
    }
    
    one   {
      set ::image 1
      ::wtk::.d.ib configure -src /images/cameralens1.jpg
    }
    
    two   {
      set ::image 2
      ::wtk::.d.ib configure -src /images/rainbow.gif
    }
    
    three {
      set ::image 3
      ::wtk::.d.ib configure -src /images/cameralens2.jpg
    }    
  }
}

set ::image 0

render

::wtk::focus .c.feet
::wtk::bind . <Return> {calculate}









|




|




|




|








|




|




|




|












63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
  }
}
  
proc swapimages {} {
  switch -- $::image {
    0 {
      set ::image 1; set ::textval "one"
      .d.ib configure -src /images/cameralens1.jpg
    }
    
    1 {
      set ::image 2; set ::textval "two"
      .d.ib configure -src /images/rainbow.gif
    }
    
    2 {
      set ::image 3; set ::textval "three"
      .d.ib configure -src /images/cameralens2.jpg
    }
    
    3 {
      set ::image 0; set ::textval "zero"
      .d.ib configure -src /images/logo.png
    }
  }
}
  
proc selectimg {} {
  switch -- $::textval {
    zero  {
      set ::image 0
      .d.ib configure -src /images/logo.png
    }
    
    one   {
      set ::image 1
      .d.ib configure -src /images/cameralens1.jpg
    }
    
    two   {
      set ::image 2
      .d.ib configure -src /images/rainbow.gif
    }
    
    three {
      set ::image 3
      .d.ib configure -src /images/cameralens2.jpg
    }    
  }
}

set ::image 0

render

::wtk::focus .c.feet
::wtk::bind . <Return> {calculate}


Changes to geomanagers/wtk-grid.tcl.

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
..
27
28
29
30
31
32
33


34
35
36
37
38
39
40
41
42
..
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
..
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
    proc grid {w args} {
        variable widgets
        switch -exact -- $w {
            "columnconfigure" {}        
            "rowconfigure" {}
            default {
              set w [namespace tail $w]
              set wobj ::wtk::$w
              
              puts [list grid $w [info object class $wobj]]
              
              set parent [join [lrange [split $w .] 0 end-1] .]
              if {$parent eq ""} {set parent "."}
              if {![info exists widgets($parent)]} {error "no parent widget found"}
              if {![$wobj was_created]} {$wobj do_create}
................................................................................
    }
    
    # internal state kept for each master
    odie::class ::wtk::GridState {

        class_method for {w} {
          my variable states


          if {![info exists states($w)]} {
            set states($w) [my create ::wtk::${w}#grid ::wtk::$w]
          }
          return $states($w)
        }
        class_method _reset {} {
          my variable states
          foreach {w obj} [array get states] {
            $obj destroy
................................................................................
        variable columns {}
        variable slaves ; # array
        variable tabledata {}
        variable master
        variable id

        constructor {w} {
          set master ::wtk::[namespace tail $w]
          my variable rows columns tabledata master id
          set rows {}
          set columns {}
          set tabledata {}

          set id [string map "obj grid" [$master id]]
        }
................................................................................
        method jsobj {} {return "\$('#$id')\[0\]"}
        method _debug {} {
          my variable rows columns tabledata master id slaves
          return [list master $master rows $rows columns $columns slaves [array get slaves] tabledata $tabledata]
        }
        method addSlave {w args} {
          my variable rows columns tabledata master id slaves
          set w ::wtk::[namespace tail $w]
          if {[dict keys $args -column] eq "" || [dict keys $args -row] eq ""} {error "need to supply -column and -row"}; # NOTE: caller ensures we have a column and row
          set slaves($w) $args
          set colnum [dict get $args -column]; set rownum [dict get $args -row]
          #puts "\n        BEFORE: $tabledata  -> col=$colnum row=$rownum w=$w"
          if {$colnum ni $columns} {
            my _insertColumn $colnum
          }







|







 







>
>

|







 







|







 







|







5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
..
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
..
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
..
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
    proc grid {w args} {
        variable widgets
        switch -exact -- $w {
            "columnconfigure" {}        
            "rowconfigure" {}
            default {
              set w [namespace tail $w]
              set wobj ::$w
              
              puts [list grid $w [info object class $wobj]]
              
              set parent [join [lrange [split $w .] 0 end-1] .]
              if {$parent eq ""} {set parent "."}
              if {![info exists widgets($parent)]} {error "no parent widget found"}
              if {![$wobj was_created]} {$wobj do_create}
................................................................................
    }
    
    # internal state kept for each master
    odie::class ::wtk::GridState {

        class_method for {w} {
          my variable states
          set w [namespace tail $w]

          if {![info exists states($w)]} {
            set states($w) [my create ::wtk::${w}#grid $w]
          }
          return $states($w)
        }
        class_method _reset {} {
          my variable states
          foreach {w obj} [array get states] {
            $obj destroy
................................................................................
        variable columns {}
        variable slaves ; # array
        variable tabledata {}
        variable master
        variable id

        constructor {w} {
          set master [namespace tail $w]
          my variable rows columns tabledata master id
          set rows {}
          set columns {}
          set tabledata {}

          set id [string map "obj grid" [$master id]]
        }
................................................................................
        method jsobj {} {return "\$('#$id')\[0\]"}
        method _debug {} {
          my variable rows columns tabledata master id slaves
          return [list master $master rows $rows columns $columns slaves [array get slaves] tabledata $tabledata]
        }
        method addSlave {w args} {
          my variable rows columns tabledata master id slaves
          set w [namespace tail $w]
          if {[dict keys $args -column] eq "" || [dict keys $args -row] eq ""} {error "need to supply -column and -row"}; # NOTE: caller ensures we have a column and row
          set slaves($w) $args
          set colnum [dict get $args -column]; set rownum [dict get $args -row]
          #puts "\n        BEFORE: $tabledata  -> col=$colnum row=$rownum w=$w"
          if {$colnum ni $columns} {
            my _insertColumn $colnum
          }

Changes to lib/wtk-base.tcl.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
..
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
..
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
# are interpreted and used to update internal widget state here, which often triggers
# callbacks or other event bindings.
#
# Communication with the client is solely via the "fromclient" and "toclient" routines
# (the latter of which is setup in the ::wtk::init call).

package require TclOO
package require snit
package require log

source odie/index.tcl

###
# Add "option"
###
................................................................................
    variable widgets
    variable wobj
    variable _nextid -1
    variable _sender ""

    # Initialization and communication
    proc init {sender} {
      puts [list ::wtk::init $sender]
      set ::wtk::_sender $sender
      ::wtk::Widget "."
      return ""
    }

    # for debugging
    proc _reset {} {
................................................................................
          set wobj [self]
          oo::objdefine [self] forward tkpath $tkpath
          #my graft tkpath $tkpath

          dict set ::wtk::widgets($tkpath) id $id
          set ::wtk::wobj($id) [self]
          foreach {var info} [my property options] {
            puts [list -$var [dictGet $info -default]]
            set options(-$var) [dictGet $info -default]
          }
          
          my configurelist {*}$args
          return $new_tkpath
        }
        

        class_method unknown {objname args} {
          if {[string index $objname 0] eq "."} {
            my create ::wtk::$objname $objname {*}$args
            return $objname
          }
          error "Unknown method $objname. Valid: [info class methods [info object class [self]]]"
        }

        class_method option args {
          puts $args







<







 







<







 







<










|







4
5
6
7
8
9
10

11
12
13
14
15
16
17
..
19
20
21
22
23
24
25

26
27
28
29
30
31
32
..
81
82
83
84
85
86
87

88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
# are interpreted and used to update internal widget state here, which often triggers
# callbacks or other event bindings.
#
# Communication with the client is solely via the "fromclient" and "toclient" routines
# (the latter of which is setup in the ::wtk::init call).

package require TclOO

package require log

source odie/index.tcl

###
# Add "option"
###
................................................................................
    variable widgets
    variable wobj
    variable _nextid -1
    variable _sender ""

    # Initialization and communication
    proc init {sender} {

      set ::wtk::_sender $sender
      ::wtk::Widget "."
      return ""
    }

    # for debugging
    proc _reset {} {
................................................................................
          set wobj [self]
          oo::objdefine [self] forward tkpath $tkpath
          #my graft tkpath $tkpath

          dict set ::wtk::widgets($tkpath) id $id
          set ::wtk::wobj($id) [self]
          foreach {var info} [my property options] {

            set options(-$var) [dictGet $info -default]
          }
          
          my configurelist {*}$args
          return $new_tkpath
        }
        

        class_method unknown {objname args} {
          if {[string index $objname 0] eq "."} {
            my create ::$objname $objname {*}$args
            return $objname
          }
          error "Unknown method $objname. Valid: [info class methods [info object class [self]]]"
        }

        class_method option args {
          puts $args