Tcl Library Source Code

Check-in [0745c57cca]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2018 Conference, Houston/TX, US, Oct 15-19
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Aug 20.

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

Overview
Comment:Removed dedicated variables for clay's delegation and mixinmap. (They are now sub-elements of the clay dict). Refactored the practcl clay implementation to provide a better mapping of old function calls. This new practcl version now runs old practcl projects unmodified.
Timelines: family | ancestors | descendants | both | hypnotoad
Files: files | file ages | folders
SHA3-256:0745c57ccaf5d5e4f7121c663a435fcc083c3ce6aabd05860264a2a9ae6c034b
User & Date: hypnotoad 2018-07-13 16:54:53
Context
2018-07-13
19:01
Updating a bit in httpd's implementation that used to rely on access to a private variable. Added a binary encode around the grab of raw random data on unix to prevent Tcl from trying to interpret the string. check-in: 3ee985049d user: hypnotoad tags: hypnotoad
16:54
Removed dedicated variables for clay's delegation and mixinmap. (They are now sub-elements of the clay dict). Refactored the practcl clay implementation to provide a better mapping of old function calls. This new practcl version now runs old practcl projects unmodified. check-in: 0745c57cca user: hypnotoad tags: hypnotoad
14:53
Fixed the meta markup on the clay module. Moved the definition of clay::object into the metaclass.tcl file. This allows practcl to just steal the proc.tcl, class.tcl, and object.tcl files from this module to include on its own, without needing to ALSO include oo::dialect. Renamed the "source" ensemble method to "provenace" and added a new "source" which sources a file inside the object's namespace. Practcl now utilizes a minimalist snippet of the clay project, replacing its own implementation with the clay implementation. check-in: 39bd8c6989 user: hypnotoad tags: hypnotoad
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/clay/build/core.tcl.

1
2
3
4
5
6
7
8
9
package require Tcl 8.6 ;# try in pipeline.tcl. Possibly other things.
package require TclOO
package require uuid
package require oo::dialect

::namespace eval ::clay {}
::namespace eval ::clay::classes {}

set ::clay::trace 0







<
<
1
2
3
4
5
6
7


package require Tcl 8.6 ;# try in pipeline.tcl. Possibly other things.
package require TclOO
package require uuid
package require oo::dialect

::namespace eval ::clay {}
::namespace eval ::clay::classes {}


Changes to modules/clay/build/metaclass.tcl.

162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178


# clay::object
#
# This class is inherited by all classes that have options.
#
::clay::define ::clay::object {
  Variable organs {}
  Variable clay {}
  Variable mixinmap {}
  Variable claycache {}
  Variable DestroyEvent 0

  method Evolve {} {
    my Ensembles_Rebuild
  }








<

<







162
163
164
165
166
167
168

169

170
171
172
173
174
175
176


# clay::object
#
# This class is inherited by all classes that have options.
#
::clay::define ::clay::object {

  Variable clay {}

  Variable claycache {}
  Variable DestroyEvent 0

  method Evolve {} {
    my Ensembles_Rebuild
  }

Changes to modules/clay/build/object.tcl.

11
12
13
14
15
16
17



18
19
20
21
22
23
24
..
49
50
51
52
53
54
55
56
57
58
59
60
61
62
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
...
263
264
265
266
267
268
269
270
271
272
273
274
275

276
277
278
279
280
281
282
283
284
  method clay {submethod args} {
    my variable clay claycache clayorder
    if {![info exists clay]} {set clay {}}
    if {![info exists claycache]} {set claycache {}}
    if {![info exists clayorder] || [llength $clayorder]==0} {
      set clayorder [::clay::ancestors [info object class [self]] {*}[info object mixins [self]]]
    }



    switch $submethod {
      ancestors {
        return $clayorder
      }
      cget {
        # Leaf searches return one data field at a time
        # Search in our local dict
................................................................................
              return $value
            }
          }
        }
        return {}
      }
      delegate {
        my variable delegate
        if {![info exists delegate]} {
          set delegate {}
        }
        if {![dict exists delegate <class>]} {
          dict set delegate <class> [info object class [self]]
        }
        if {[llength $args]==0} {
          return $delegate

        }
        if {[llength $args]==1} {
          set stub <[string trim [lindex $args 0] <>]>
          if {![dict exists $delegate $stub]} {
            return {}
          }
          return [dict get $delegate $stub]
        }
        if {([llength $args] % 2)} {
          error "Usage: delegate
    OR
    delegate stub
    OR
    delegate stub OBJECT ?stub OBJECT? ..."
        }
        foreach {stub object} $args {
          set stub <[string trim $stub <>]>
          dict set delegate $stub $object
          oo::objdefine [self] forward ${stub} $object
          oo::objdefine [self] export ${stub}
        }
      }
      dump {
        # Do a full dump of clay data
        set result $clay
................................................................................
              puts stderr "[self] MIXIN ERROR PEEKING $class:\n[dict get $errdat -errorinfo]"
            }
            break
          }
        }
      }
      mixinmap {
        my variable mixinmap
        set priorlist {}
        foreach {slot classes} $args {
          dict set mixinmap $slot $classes
        }


        set classlist {}
        foreach {item class} $mixinmap {
          if {$class ne {}} {
            lappend classlist $class
          }
        }
        my clay mixin {*}$classlist
      }
      provenance {







>
>
>







 







<
<
<
<
|
|


<
>



|


|










|







 







<
<

|

<
>

|







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
..
52
53
54
55
56
57
58




59
60
61
62

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
...
262
263
264
265
266
267
268


269
270
271

272
273
274
275
276
277
278
279
280
281
  method clay {submethod args} {
    my variable clay claycache clayorder
    if {![info exists clay]} {set clay {}}
    if {![info exists claycache]} {set claycache {}}
    if {![info exists clayorder] || [llength $clayorder]==0} {
      set clayorder [::clay::ancestors [info object class [self]] {*}[info object mixins [self]]]
    }
    if {$::clay::trace > 1} {
      puts [list [info object class [self]] / [self] clay $submethod {*}$args]
    }
    switch $submethod {
      ancestors {
        return $clayorder
      }
      cget {
        # Leaf searches return one data field at a time
        # Search in our local dict
................................................................................
              return $value
            }
          }
        }
        return {}
      }
      delegate {




        if {![dict exists $clay delegate/ <class>]} {
          dict set clay delegate/ <class> [info object class [self]]
        }
        if {[llength $args]==0} {

          return [dict get $clay delegate/]
        }
        if {[llength $args]==1} {
          set stub <[string trim [lindex $args 0] <>]>
          if {![dict exists $clay delegate/ $stub]} {
            return {}
          }
          return [dict get $clay delegate/ $stub]
        }
        if {([llength $args] % 2)} {
          error "Usage: delegate
    OR
    delegate stub
    OR
    delegate stub OBJECT ?stub OBJECT? ..."
        }
        foreach {stub object} $args {
          set stub <[string trim $stub <>]>
          dict set clay delegate/ $stub $object
          oo::objdefine [self] forward ${stub} $object
          oo::objdefine [self] export ${stub}
        }
      }
      dump {
        # Do a full dump of clay data
        set result $clay
................................................................................
              puts stderr "[self] MIXIN ERROR PEEKING $class:\n[dict get $errdat -errorinfo]"
            }
            break
          }
        }
      }
      mixinmap {


        foreach {slot classes} $args {
          dict set clay mixin/ $slot $classes
        }

        set claycache {}
        set classlist {}
        foreach {item class} [my clay get mixin/] {
          if {$class ne {}} {
            lappend classlist $class
          }
        }
        my clay mixin {*}$classlist
      }
      provenance {

Changes to modules/clay/build/procs.tcl.




1
2
3
4
5
6
7



###
# Global utilities
###
if {[info commands ::ladd] eq {}} {
  proc ladd {varname args} {
    upvar 1 $varname var
    if ![info exists var] {
>
>
>







1
2
3
4
5
6
7
8
9
10
::namespace eval ::clay {}
set ::clay::trace 0

###
# Global utilities
###
if {[info commands ::ladd] eq {}} {
  proc ladd {varname args} {
    upvar 1 $varname var
    if ![info exists var] {

Changes to modules/clay/clay.tcl.

455
456
457
458
459
460
461



462
463
464
465
466
467
468
...
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508

509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
...
707
708
709
710
711
712
713
714
715
716
717
718
719

720
721
722
723
724
725
726
727
728
...
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
  method clay {submethod args} {
    my variable clay claycache clayorder
    if {![info exists clay]} {set clay {}}
    if {![info exists claycache]} {set claycache {}}
    if {![info exists clayorder] || [llength $clayorder]==0} {
      set clayorder [::clay::ancestors [info object class [self]] {*}[info object mixins [self]]]
    }



    switch $submethod {
      ancestors {
        return $clayorder
      }
      cget {
        # Leaf searches return one data field at a time
        # Search in our local dict
................................................................................
              return $value
            }
          }
        }
        return {}
      }
      delegate {
        my variable delegate
        if {![info exists delegate]} {
          set delegate {}
        }
        if {![dict exists delegate <class>]} {
          dict set delegate <class> [info object class [self]]
        }
        if {[llength $args]==0} {
          return $delegate

        }
        if {[llength $args]==1} {
          set stub <[string trim [lindex $args 0] <>]>
          if {![dict exists $delegate $stub]} {
            return {}
          }
          return [dict get $delegate $stub]
        }
        if {([llength $args] % 2)} {
          error "Usage: delegate
    OR
    delegate stub
    OR
    delegate stub OBJECT ?stub OBJECT? ..."
        }
        foreach {stub object} $args {
          set stub <[string trim $stub <>]>
          dict set delegate $stub $object
          oo::objdefine [self] forward ${stub} $object
          oo::objdefine [self] export ${stub}
        }
      }
      dump {
        # Do a full dump of clay data
        set result $clay
................................................................................
              puts stderr "[self] MIXIN ERROR PEEKING $class:\n[dict get $errdat -errorinfo]"
            }
            break
          }
        }
      }
      mixinmap {
        my variable mixinmap
        set priorlist {}
        foreach {slot classes} $args {
          dict set mixinmap $slot $classes
        }


        set classlist {}
        foreach {item class} $mixinmap {
          if {$class ne {}} {
            lappend classlist $class
          }
        }
        my clay mixin {*}$classlist
      }
      provenance {
................................................................................


# clay::object
#
# This class is inherited by all classes that have options.
#
::clay::define ::clay::object {
  Variable organs {}
  Variable clay {}
  Variable mixinmap {}
  Variable claycache {}
  Variable DestroyEvent 0

  method Evolve {} {
    my Ensembles_Rebuild
  }








>
>
>







 







<
<
<
<
|
|


<
>



|


|










|







 







<
<

|

<
>

|







 







<

<







455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
...
496
497
498
499
500
501
502




503
504
505
506

507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
...
706
707
708
709
710
711
712


713
714
715

716
717
718
719
720
721
722
723
724
725
...
926
927
928
929
930
931
932

933

934
935
936
937
938
939
940
  method clay {submethod args} {
    my variable clay claycache clayorder
    if {![info exists clay]} {set clay {}}
    if {![info exists claycache]} {set claycache {}}
    if {![info exists clayorder] || [llength $clayorder]==0} {
      set clayorder [::clay::ancestors [info object class [self]] {*}[info object mixins [self]]]
    }
    if {$::clay::trace > 1} {
      puts [list [info object class [self]] / [self] clay $submethod {*}$args]
    }
    switch $submethod {
      ancestors {
        return $clayorder
      }
      cget {
        # Leaf searches return one data field at a time
        # Search in our local dict
................................................................................
              return $value
            }
          }
        }
        return {}
      }
      delegate {




        if {![dict exists $clay delegate/ <class>]} {
          dict set clay delegate/ <class> [info object class [self]]
        }
        if {[llength $args]==0} {

          return [dict get $clay delegate/]
        }
        if {[llength $args]==1} {
          set stub <[string trim [lindex $args 0] <>]>
          if {![dict exists $clay delegate/ $stub]} {
            return {}
          }
          return [dict get $clay delegate/ $stub]
        }
        if {([llength $args] % 2)} {
          error "Usage: delegate
    OR
    delegate stub
    OR
    delegate stub OBJECT ?stub OBJECT? ..."
        }
        foreach {stub object} $args {
          set stub <[string trim $stub <>]>
          dict set clay delegate/ $stub $object
          oo::objdefine [self] forward ${stub} $object
          oo::objdefine [self] export ${stub}
        }
      }
      dump {
        # Do a full dump of clay data
        set result $clay
................................................................................
              puts stderr "[self] MIXIN ERROR PEEKING $class:\n[dict get $errdat -errorinfo]"
            }
            break
          }
        }
      }
      mixinmap {


        foreach {slot classes} $args {
          dict set clay mixin/ $slot $classes
        }

        set claycache {}
        set classlist {}
        foreach {item class} [my clay get mixin/] {
          if {$class ne {}} {
            lappend classlist $class
          }
        }
        my clay mixin {*}$classlist
      }
      provenance {
................................................................................


# clay::object
#
# This class is inherited by all classes that have options.
#
::clay::define ::clay::object {

  Variable clay {}

  Variable claycache {}
  Variable DestroyEvent 0

  method Evolve {} {
    my Ensembles_Rebuild
  }

Changes to modules/practcl/build/build.tcl.

1
2
3
4
5
6
7
8
9
10
11
set srcdir [file dirname [file normalize [file join [pwd] [info script]]]]
set moddir [file dirname $srcdir]

set version 0.11.1
set tclversion 8.5
set module [file tail $moddir]

set fout [open [file join $moddir [file tail $module].tcl] w]
fconfigure $fout -translation lf
dict set map %module% $module
dict set map %version% $version



|







1
2
3
4
5
6
7
8
9
10
11
set srcdir [file dirname [file normalize [file join [pwd] [info script]]]]
set moddir [file dirname $srcdir]

set version 0.12
set tclversion 8.5
set module [file tail $moddir]

set fout [open [file join $moddir [file tail $module].tcl] w]
fconfigure $fout -translation lf
dict set map %module% $module
dict set map %version% $version

Changes to modules/practcl/build/class/distro/baseclass.tcl.

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
..
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
...
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
      scm  None
      hash {}
      maxdate {}
      tags {}
      isodate {}
    }
  }

  method DistroMixIn {} {
    my define set scm none
  }

  method Sandbox {} {
    if {[my define exists sandbox]} {
      return [my define get sandbox]
    }
    if {[my clay delegate project] ni {::noop {}}} {
      set sandbox [my <project> define get sandbox]
      if {$sandbox ne {}} {
        my define set sandbox $sandbox
        return $sandbox
      }
    }
    set sandbox [file normalize [file join $::CWD ..]]
................................................................................

oo::objdefine ::practcl::distribution {

  method Sandbox {object} {
    if {[$object define exists sandbox]} {
      return [$object define get sandbox]
    }
    if {[$object clay delegate project] ni {::noop {}}} {
      set sandbox [$object <project> define get sandbox]
      if {$sandbox ne {}} {
        $object define set sandbox $sandbox
        return $sandbox
      }
    }
    set pkg [$object define get name]
................................................................................
      $object define set srcdir $srcdir
    }

    set classprefix ::practcl::distribution.
    if {[file exists $srcdir]} {
      foreach class [::info commands ${classprefix}*] {
        if {[$class claim_path $srcdir]} {
          $object clay mixinmap distribution $class
          $object define set scm [string range $class [string length ::practcl::distribution.] end]
          return [$object define get scm]
        }
      }
    }
    foreach class [::info commands ${classprefix}*] {
      if {[$class claim_object $object]} {
        $object clay mixinmap distribution $class
        $object define set scm [string range $class [string length ::practcl::distribution.] end]
        return [$object define get scm]
      }
    }
    if {[$object define get scm] eq {} && [$object define exists file_url]} {
      set class ::practcl::distribution.snapshot
      $object define set scm snapshot
      $object clay mixinmap distribution $class
      return [$object define get scm]
    }
    error "Cannot determine source distribution method"
  }

  method claim_path path {
    return false
  }
  method claim_object object {
    return false
  }
}







|








|







 







|







 







|







|







|












11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
..
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
...
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
      scm  None
      hash {}
      maxdate {}
      tags {}
      isodate {}
    }
  }
  
  method DistroMixIn {} {
    my define set scm none
  }

  method Sandbox {} {
    if {[my define exists sandbox]} {
      return [my define get sandbox]
    }
    if {[my organ project] ni {::noop {}}} {
      set sandbox [my <project> define get sandbox]
      if {$sandbox ne {}} {
        my define set sandbox $sandbox
        return $sandbox
      }
    }
    set sandbox [file normalize [file join $::CWD ..]]
................................................................................

oo::objdefine ::practcl::distribution {

  method Sandbox {object} {
    if {[$object define exists sandbox]} {
      return [$object define get sandbox]
    }
    if {[$object organ project] ni {::noop {}}} {
      set sandbox [$object <project> define get sandbox]
      if {$sandbox ne {}} {
        $object define set sandbox $sandbox
        return $sandbox
      }
    }
    set pkg [$object define get name]
................................................................................
      $object define set srcdir $srcdir
    }

    set classprefix ::practcl::distribution.
    if {[file exists $srcdir]} {
      foreach class [::info commands ${classprefix}*] {
        if {[$class claim_path $srcdir]} {
          $object mixin distribution $class
          $object define set scm [string range $class [string length ::practcl::distribution.] end]
          return [$object define get scm]
        }
      }
    }
    foreach class [::info commands ${classprefix}*] {
      if {[$class claim_object $object]} {
        $object mixin distribution $class
        $object define set scm [string range $class [string length ::practcl::distribution.] end]
        return [$object define get scm]
      }
    }
    if {[$object define get scm] eq {} && [$object define exists file_url]} {
      set class ::practcl::distribution.snapshot
      $object define set scm snapshot
      $object mixin distribution $class
      return [$object define get scm]
    }
    error "Cannot determine source distribution method"
  }

  method claim_path path {
    return false
  }
  method claim_object object {
    return false
  }
}

Changes to modules/practcl/build/class/metaclass.tcl.

63
64
65
66
67
68
69




70
71
72
73
74
75
76
...
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
...
162
163
164
165
166
167
168
169


170
171
172
173
174
175
176
177
178
179
180
181
182

183
184
185
186
187
188
189
190
191
192
193
194
195
196
197




198
199
200
201
202
203
204
        }
      }
      default {
        array $submethod define {*}$args
      }
    }
  }





  method initialize {} {}


  method link {command args} {
    my variable links
    switch $command {
................................................................................
      } {
        if {[string match $pattern $class]} {
           set mixinslot $slot
           break
        }
      }
      if {$mixinslot ne {}} {
        my clay mixin $mixinslot $class
      } elseif {[info command $class] ne {}} {
        if {[info object class [self]] ne $class} {
          ::oo::objdefine [self] class $class
          ::practcl::debug [self] morph $class
           my define set class $class
        }
      } else {
................................................................................
    }
    if {[::info exists define(oodefine)]} {
      ::oo::objdefine [self] $define(oodefine)
      #unset define(oodefine)
    }
  }

  method Practcl_Mixin_Pattern {slot classname} {


    set map [list @slot@ $slot @name@ $classname]
    foreach pattern [split [string map $map {
      @name@
      @slot@.@name@
      ::practcl::@name@
      ::practcl::@slot@.@name@
      ::practcl::@slot@*@name@
      ::practcl::*@name@*
    }] \n] {
      set pattern [string trim $pattern]
      set matches [info commands $pattern]
      if {![llength $matches]} continue
      return [lindex $matches 0]

    }
  }

  method mixin {slot classname} {
    my variable mixinslot
    set class [my Practcl_Mixin_Pattern $slot $classname]
    ::practcl::debug [self] mixin $slot $class
    dict set mixinslot $slot $class
    set mixins {}
    foreach {s c} $mixinslot {
      if {$c eq {}} continue
      lappend mixins $c
    }
    oo::objdefine [self] mixin {*}$mixins
  }





  method script script {
    eval $script
  }

  method select {} {
    my variable define







>
>
>
>







 







|







 







|
>
>












|
>

<
<
<
<
<









>
>
>
>







63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
...
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
...
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190





191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
        }
      }
      default {
        array $submethod define {*}$args
      }
    }
  }

  method graft args {
    return [my clay delegate {*}$args]
  }

  method initialize {} {}


  method link {command args} {
    my variable links
    switch $command {
................................................................................
      } {
        if {[string match $pattern $class]} {
           set mixinslot $slot
           break
        }
      }
      if {$mixinslot ne {}} {
        my mixin $mixinslot $class
      } elseif {[info command $class] ne {}} {
        if {[info object class [self]] ne $class} {
          ::oo::objdefine [self] class $class
          ::practcl::debug [self] morph $class
           my define set class $class
        }
      } else {
................................................................................
    }
    if {[::info exists define(oodefine)]} {
      ::oo::objdefine [self] $define(oodefine)
      #unset define(oodefine)
    }
  }

  method mixin {slot classname} {
    my variable mixinslot
    set class {}
    set map [list @slot@ $slot @name@ $classname]
    foreach pattern [split [string map $map {
      @name@
      @slot@.@name@
      ::practcl::@name@
      ::practcl::@slot@.@name@
      ::practcl::@slot@*@name@
      ::practcl::*@name@*
    }] \n] {
      set pattern [string trim $pattern]
      set matches [info commands $pattern]
      if {![llength $matches]} continue
      set class [lindex $matches 0]
      break
    }





    ::practcl::debug [self] mixin $slot $class
    dict set mixinslot $slot $class
    set mixins {}
    foreach {s c} $mixinslot {
      if {$c eq {}} continue
      lappend mixins $c
    }
    oo::objdefine [self] mixin {*}$mixins
  }

  method organ args {
    return [my clay delegate {*}$args]
  }

  method script script {
    eval $script
  }

  method select {} {
    my variable define

Changes to modules/practcl/build/class/module.tcl.

158
159
160
161
162
163
164
165

166
167
168
169
170
171
172
        }
      }
    }
  }

  method child which {
    switch $which {
      delegate {

        return [list project [my define get project] module [self]]
      }
    }
  }

 ###
  # This methods generates the contents of an amalgamated .c file







|
>







158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
        }
      }
    }
  }

  method child which {
    switch $which {
      delegate -
      organs {
        return [list project [my define get project] module [self]]
      }
    }
  }

 ###
  # This methods generates the contents of an amalgamated .c file

Changes to modules/practcl/build/class/object.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
::oo::class create ::practcl::object {
  superclass ::practcl::metaclass

  constructor {parent args} {
    my variable links define
    set delegates [$parent child delegate]
    my clay delegate {*}$delegates
    array set define $delegates
    array set define [$parent child define]
    array set links {}
    if {[llength $args]==1 && [file exists [lindex $args 0]]} {
      my define set filename [lindex $args 0]
      ::practcl::product select [self]
    } elseif {[llength $args] == 1} {
      set data  [uplevel 1 [list subst [lindex $args 0]]]





|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
::oo::class create ::practcl::object {
  superclass ::practcl::metaclass

  constructor {parent args} {
    my variable links define
    set organs [$parent child organs]
    my clay delegate {*}$organs
    array set define $organs
    array set define [$parent child define]
    array set links {}
    if {[llength $args]==1 && [file exists [lindex $args 0]]} {
      my define set filename [lindex $args 0]
      ::practcl::product select [self]
    } elseif {[llength $args] == 1} {
      set data  [uplevel 1 [list subst [lindex $args 0]]]

Changes to modules/practcl/build/class/product.tcl.

587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
        }
      }
    }
    if {$class ne {}} {
      $object morph $class
    }
    if {$mixin ne {}} {
      $object clay mixinmap product $mixin
    }
  }
}

###
# Flesh out several trivial varieties of product
###







|







587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
        }
      }
    }
    if {$class ne {}} {
      $object morph $class
    }
    if {$mixin ne {}} {
      $object mixin product $mixin
    }
  }
}

###
# Flesh out several trivial varieties of product
###

Changes to modules/practcl/build/class/project/baseclass.tcl.

28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
...
120
121
122
123
124
125
126
127

128
129
130
131
132
133
134
...
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
    # DEFS fields need to be passed unchanged and unsubstituted
    # as we need to preserve their escape characters
    foreach field {TCL_DEFS DEFS TK_DEFS} {
      if {[dict exists $rawcontents $field]} {
        dict set contents $field [dict get $rawcontents $field]
      }
    }
    my clay delegate module [self]
    array set define $contents
    ::practcl::toolset select [self]
    my initialize
  }

  method add_object object {
    my link object $object
................................................................................
    }
    $tkobj define set config_opts $tk_config_opts
    $tkobj compile
  }

  method child which {
    switch $which {
      delegate {

	# A library can be a project, it can be a module. Any
	# subordinate modules will indicate their existance
        return [list project [self] module [self]]
      }
    }
  }

................................................................................
      return $obj
    }
    ${obj} {*}$args
  }


  method tclcore {} {
    if {[info commands [set obj [my clay delegate tclcore]]] ne {}} {
      return $obj
    }
    if {[info commands [set obj [my project TCLCORE]]] ne {}} {
      my clay delegate tclcore $obj
      return $obj
    }
    if {[info commands [set obj [my project tcl]]] ne {}} {
      my clay delegate tclcore $obj
      return $obj
    }
    if {[info commands [set obj [my tool tcl]]] ne {}} {
      my clay delegate tclcore $obj
      return $obj
    }
    # Provide a fallback
    set obj [my add_tool tcl {
      tag release class subproject.core
      fossil_url http://core.tcl.tk/tcl
    }]
    my clay delegate tclcore $obj
    return $obj
  }

  method tkcore {} {
    if {[set obj [my clay delegate tkcore]] ne {}} {
      return $obj
    }
    if {[set obj [my clay delegate tk]] ne {}} {
      my clay delegate tkcore $obj
      return $obj
    }
    if {[set obj [my tool tk]] ne {}} {
      my clay delegate tkcore $obj
      return $obj
    }
    # Provide a fallback
    set obj [my add_tool tk {
      tag release class tool.core
      fossil_url http://core.tcl.tk/tk
    }]
    my clay delegate tkcore $obj
    return $obj
  }

  method tool {pkg args} {
    set obj ::practcl::OBJECT::TOOL.$pkg
    if {[llength $args]==0} {
      return $obj
    }
    ${obj} {*}$args
  }
}







|







 







|
>







 







|



|



|



|







|




|


|
|



|







|











28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
...
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
...
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
    # DEFS fields need to be passed unchanged and unsubstituted
    # as we need to preserve their escape characters
    foreach field {TCL_DEFS DEFS TK_DEFS} {
      if {[dict exists $rawcontents $field]} {
        dict set contents $field [dict get $rawcontents $field]
      }
    }
    my graft module [self]
    array set define $contents
    ::practcl::toolset select [self]
    my initialize
  }

  method add_object object {
    my link object $object
................................................................................
    }
    $tkobj define set config_opts $tk_config_opts
    $tkobj compile
  }

  method child which {
    switch $which {
      delegate -
      organs {
	# A library can be a project, it can be a module. Any
	# subordinate modules will indicate their existance
        return [list project [self] module [self]]
      }
    }
  }

................................................................................
      return $obj
    }
    ${obj} {*}$args
  }


  method tclcore {} {
    if {[info commands [set obj [my organ tclcore]]] ne {}} {
      return $obj
    }
    if {[info commands [set obj [my project TCLCORE]]] ne {}} {
      my graft tclcore $obj
      return $obj
    }
    if {[info commands [set obj [my project tcl]]] ne {}} {
      my graft tclcore $obj
      return $obj
    }
    if {[info commands [set obj [my tool tcl]]] ne {}} {
      my graft tclcore $obj
      return $obj
    }
    # Provide a fallback
    set obj [my add_tool tcl {
      tag release class subproject.core
      fossil_url http://core.tcl.tk/tcl
    }]
    my graft tclcore $obj
    return $obj
  }

  method tkcore {} {
    if {[set obj [my organ tkcore]] ne {}} {
      return $obj
    }
    if {[set obj [my project tk]] ne {}} {
      my graft tkcore $obj
      return $obj
    }
    if {[set obj [my tool tk]] ne {}} {
      my graft tkcore $obj
      return $obj
    }
    # Provide a fallback
    set obj [my add_tool tk {
      tag release class tool.core
      fossil_url http://core.tcl.tk/tk
    }]
    my graft tkcore $obj
    return $obj
  }

  method tool {pkg args} {
    set obj ::practcl::OBJECT::TOOL.$pkg
    if {[llength $args]==0} {
      return $obj
    }
    ${obj} {*}$args
  }
}

Changes to modules/practcl/build/class/subproject/baseclass.tcl.

8
9
10
11
12
13
14
15

16
17
18
19
20
21
22

  method BuildDir {PWD} {
    return [my define get srcdir]
  }

  method child which {
    switch $which {
      delegate {

	# A library can be a project, it can be a module. Any
	# subordinate modules will indicate their existance
        return [list project [self] module [self]]
      }
    }
  }








|
>







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

  method BuildDir {PWD} {
    return [my define get srcdir]
  }

  method child which {
    switch $which {
      delegate -
      organs {
	# A library can be a project, it can be a module. Any
	# subordinate modules will indicate their existance
        return [list project [self] module [self]]
      }
    }
  }

Changes to modules/practcl/build/class/target.tcl.

7
8
9
10
11
12
13
14


15
16
17
18
19
20
21
..
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
..
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
    set triggered 0
    set domake 0
    set define(name) $name
    set define(action) {}
    array set define $info
    my select
    my initialize
    my clay delegate {*}[$module_object child delegate]


    if {$action_body ne {}} {
      set define(action) $action_body
    }
  }

  method do {} {
    my variable domake
................................................................................
        if {$filename ne {} && ![file exists $filename]} {
          set needs_make 1
        }
      }
    }
    return $needs_make
  }

  method output {} {
    set result {}
    set filename [my define get filename]
    if {$filename ne {}} {
      lappend result $filename
    }
    foreach filename [my define get files] {
................................................................................

  method reset {} {
    my variable triggered domake needs_make
    set triggerd 0
    set domake 0
    set needs_make 0
  }

  method triggers {} {
    my variable triggered domake define
    if {$triggered} {
      return $domake
    }
    set triggered 1
    set make_objects [my <module> make objects]







|
>
>







 







|







 







|







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
..
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
..
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
    set triggered 0
    set domake 0
    set define(name) $name
    set define(action) {}
    array set define $info
    my select
    my initialize
    foreach {stub obj} [$module_object child organs] {
      my graft $stub $obj
    }
    if {$action_body ne {}} {
      set define(action) $action_body
    }
  }

  method do {} {
    my variable domake
................................................................................
        if {$filename ne {} && ![file exists $filename]} {
          set needs_make 1
        }
      }
    }
    return $needs_make
  }
  
  method output {} {
    set result {}
    set filename [my define get filename]
    if {$filename ne {}} {
      lappend result $filename
    }
    foreach filename [my define get files] {
................................................................................

  method reset {} {
    my variable triggered domake needs_make
    set triggerd 0
    set domake 0
    set needs_make 0
  }
  
  method triggers {} {
    my variable triggered domake define
    if {$triggered} {
      return $domake
    }
    set triggered 1
    set make_objects [my <module> make objects]

Changes to modules/practcl/build/class/toolset/baseclass.tcl.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
...
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
...
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
oo::class create ::practcl::toolset {
  ###
  # find or fake a key/value list describing this project
  ###
  method config.sh {} {
    return [my read_configuration]
  }

  method BuildDir {PWD} {
    set name [my define get name]
    set debug [my define get debug 0]
    if {[my <project> define get LOCAL 0]} {
      return [my define get builddir [file join $PWD local $name]]
    }
    if {$debug} {
      return [my define get builddir [file join $PWD debug $name]]
    } else {
      return [my define get builddir [file join $PWD pkg $name]]
    }
  }

  method MakeDir {srcdir} {
    return $srcdir
  }

  method read_configuration {} {
    my variable conf_result
    if {[info exists conf_result]} {
      return $conf_result
    }
    set result {}
    set name [my define get name]
................................................................................
    }
    set srcdir [my SourceRoot]
    set PWD [pwd]
    cd $srcdir
    ::practcl::dotclexec $critcl {*}$args
    cd $PWD
  }

  method make-autodetect {} {}
}


oo::objdefine ::practcl::toolset {


................................................................................
    # Select the toolset to use for this project
    ###
    if {[$object define exists toolset]} {
      return [$object define get toolset]
    }
    set class [$object define get toolset]
    if {$class ne {}} {
      $object clay mixinmap toolset [my Practcl_Mixin_Pattern toolset $class]
    } else {
      if {[info exists ::env(VisualStudioVersion)]} {
        $object clay mixinmap toolset ::practcl::toolset.msvc
      } else {
        $object clay mixinmap toolset ::practcl::toolset.gcc
      }
    }
  }
}







|












|



|







 







|







 







|


|

|




6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
...
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
...
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
oo::class create ::practcl::toolset {
  ###
  # find or fake a key/value list describing this project
  ###
  method config.sh {} {
    return [my read_configuration]
  }
  
  method BuildDir {PWD} {
    set name [my define get name]
    set debug [my define get debug 0]
    if {[my <project> define get LOCAL 0]} {
      return [my define get builddir [file join $PWD local $name]]
    }
    if {$debug} {
      return [my define get builddir [file join $PWD debug $name]]
    } else {
      return [my define get builddir [file join $PWD pkg $name]]
    }
  }
  
  method MakeDir {srcdir} {
    return $srcdir
  }
  
  method read_configuration {} {
    my variable conf_result
    if {[info exists conf_result]} {
      return $conf_result
    }
    set result {}
    set name [my define get name]
................................................................................
    }
    set srcdir [my SourceRoot]
    set PWD [pwd]
    cd $srcdir
    ::practcl::dotclexec $critcl {*}$args
    cd $PWD
  }
  
  method make-autodetect {} {}
}


oo::objdefine ::practcl::toolset {


................................................................................
    # Select the toolset to use for this project
    ###
    if {[$object define exists toolset]} {
      return [$object define get toolset]
    }
    set class [$object define get toolset]
    if {$class ne {}} {
      $object mixin toolset $class
    } else {
      if {[info exists ::env(VisualStudioVersion)]} {
        $object mixin toolset ::practcl::toolset.msvc
      } else {
        $object mixin toolset ::practcl::toolset.gcc
      }
    }
  }
}

Changes to modules/practcl/pkgIndex.tcl.

1
2
3
4
###
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded practcl 0.11.1 [list source [file join $dir practcl.tcl]]



|

1
2
3
4
###
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded practcl 0.12 [list source [file join $dir practcl.tcl]]

Changes to modules/practcl/practcl.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
..
67
68
69
70
71
72
73



74
75
76
77
78
79
80
...
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535

536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
...
734
735
736
737
738
739
740
741
742
743
744
745
746

747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771






772
773
774
775
776
777
778
....
2031
2032
2033
2034
2035
2036
2037




2038
2039
2040
2041
2042
2043
2044
....
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
....
2130
2131
2132
2133
2134
2135
2136
2137


2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150

2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165




2166
2167
2168
2169
2170
2171
2172
....
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
....
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
....
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
....
3238
3239
3240
3241
3242
3243
3244
3245


3246
3247
3248
3249
3250
3251
3252
....
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
....
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
....
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
....
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
....
4828
4829
4830
4831
4832
4833
4834
4835

4836
4837
4838
4839
4840
4841
4842
....
5078
5079
5080
5081
5082
5083
5084
5085
5086
5087
5088
5089
5090
5091
5092
....
5170
5171
5172
5173
5174
5175
5176
5177

5178
5179
5180
5181
5182
5183
5184
....
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
....
5970
5971
5972
5973
5974
5975
5976
5977
5978
5979
5980
5981
5982
5983
5984
5985
5986
5987
5988
5989
5990
5991
5992
5993
....
6032
6033
6034
6035
6036
6037
6038
6039
6040
6041
6042
6043
6044
6045
6046
....
6062
6063
6064
6065
6066
6067
6068
6069
6070
6071
6072
6073
6074
6075
6076
6077
6078
6079
6080
6081
6082
6083
6084
6085
6086
6087
6088
6089
6090
6091
6092
....
6388
6389
6390
6391
6392
6393
6394
6395

6396
6397
6398
6399
6400
6401
6402
###
# Amalgamated package for practcl
# Do not edit directly, tweak the source in src/ and rerun
# build.tcl
###
package require Tcl 8.5
package provide practcl 0.11.1
namespace eval ::practcl {}

###
# START: httpwget/wget.tcl
###
###
# Tool to download file from the web
................................................................................

###
# END: httpwget/wget.tcl
###
###
# START: clay/build/procs.tcl
###



###
# Global utilities
###
if {[info commands ::ladd] eq {}} {
  proc ladd {varname args} {
    upvar 1 $varname var
    if ![info exists var] {
................................................................................
              return $value
            }
          }
        }
        return {}
      }
      delegate {
        my variable delegate
        if {![info exists delegate]} {
          set delegate {}
        }
        if {![dict exists delegate <class>]} {
          dict set delegate <class> [info object class [self]]
        }
        if {[llength $args]==0} {
          return $delegate

        }
        if {[llength $args]==1} {
          set stub <[string trim [lindex $args 0] <>]>
          if {![dict exists $delegate $stub]} {
            return {}
          }
          return [dict get $delegate $stub]
        }
        if {([llength $args] % 2)} {
          error "Usage: delegate
    OR
    delegate stub
    OR
    delegate stub OBJECT ?stub OBJECT? ..."
        }
        foreach {stub object} $args {
          set stub <[string trim $stub <>]>
          dict set delegate $stub $object
          oo::objdefine [self] forward ${stub} $object
          oo::objdefine [self] export ${stub}
        }
      }
      dump {
        # Do a full dump of clay data
        set result $clay
................................................................................
              puts stderr "[self] MIXIN ERROR PEEKING $class:\n[dict get $errdat -errorinfo]"
            }
            break
          }
        }
      }
      mixinmap {
        my variable mixinmap
        set priorlist {}
        foreach {slot classes} $args {
          dict set mixinmap $slot $classes
        }


        set classlist {}
        foreach {item class} $mixinmap {
          if {$class ne {}} {
            lappend classlist $class
          }
        }
        my clay mixin {*}$classlist
      }
      replace {
        set clay [lindex $args 0]
      }
      script {
        source [lindex $args 0]
      }
      source {
        if {[dict exists $clay {*}$args]} {
          return self
        }
        foreach class $clayorder {
          if {[$class clay exists {*}$args]} {
            return $class
          }
        }
        return {}
      }






      set {
        #puts [list [self] clay SET {*}$args]
        ::clay::dictmerge clay {*}$args
      }
      default {
        dict $submethod clay {*}$args
      }
................................................................................
        }
      }
      default {
        array $submethod define {*}$args
      }
    }
  }





  method initialize {} {}


  method link {command args} {
    my variable links
    switch $command {
................................................................................
      } {
        if {[string match $pattern $class]} {
           set mixinslot $slot
           break
        }
      }
      if {$mixinslot ne {}} {
        my clay mixin $mixinslot $class
      } elseif {[info command $class] ne {}} {
        if {[info object class [self]] ne $class} {
          ::oo::objdefine [self] class $class
          ::practcl::debug [self] morph $class
           my define set class $class
        }
      } else {
................................................................................
    }
    if {[::info exists define(oodefine)]} {
      ::oo::objdefine [self] $define(oodefine)
      #unset define(oodefine)
    }
  }

  method Practcl_Mixin_Pattern {slot classname} {


    set map [list @slot@ $slot @name@ $classname]
    foreach pattern [split [string map $map {
      @name@
      @slot@.@name@
      ::practcl::@name@
      ::practcl::@slot@.@name@
      ::practcl::@slot@*@name@
      ::practcl::*@name@*
    }] \n] {
      set pattern [string trim $pattern]
      set matches [info commands $pattern]
      if {![llength $matches]} continue
      return [lindex $matches 0]

    }
  }

  method mixin {slot classname} {
    my variable mixinslot
    set class [my Practcl_Mixin_Pattern $slot $classname]
    ::practcl::debug [self] mixin $slot $class
    dict set mixinslot $slot $class
    set mixins {}
    foreach {s c} $mixinslot {
      if {$c eq {}} continue
      lappend mixins $c
    }
    oo::objdefine [self] mixin {*}$mixins
  }





  method script script {
    eval $script
  }

  method select {} {
    my variable define
................................................................................
oo::class create ::practcl::toolset {
  ###
  # find or fake a key/value list describing this project
  ###
  method config.sh {} {
    return [my read_configuration]
  }

  method BuildDir {PWD} {
    set name [my define get name]
    set debug [my define get debug 0]
    if {[my <project> define get LOCAL 0]} {
      return [my define get builddir [file join $PWD local $name]]
    }
    if {$debug} {
      return [my define get builddir [file join $PWD debug $name]]
    } else {
      return [my define get builddir [file join $PWD pkg $name]]
    }
  }

  method MakeDir {srcdir} {
    return $srcdir
  }

  method read_configuration {} {
    my variable conf_result
    if {[info exists conf_result]} {
      return $conf_result
    }
    set result {}
    set name [my define get name]
................................................................................
    }
    set srcdir [my SourceRoot]
    set PWD [pwd]
    cd $srcdir
    ::practcl::dotclexec $critcl {*}$args
    cd $PWD
  }

  method make-autodetect {} {}
}


oo::objdefine ::practcl::toolset {


................................................................................
    # Select the toolset to use for this project
    ###
    if {[$object define exists toolset]} {
      return [$object define get toolset]
    }
    set class [$object define get toolset]
    if {$class ne {}} {
      $object clay mixinmap toolset [my Practcl_Mixin_Pattern toolset $class]
    } else {
      if {[info exists ::env(VisualStudioVersion)]} {
        $object clay mixinmap toolset ::practcl::toolset.msvc
      } else {
        $object clay mixinmap toolset ::practcl::toolset.gcc
      }
    }
  }
}

###
# END: class toolset baseclass.tcl
................................................................................
    set triggered 0
    set domake 0
    set define(name) $name
    set define(action) {}
    array set define $info
    my select
    my initialize
    my clay delegate {*}[$module_object child delegate]


    if {$action_body ne {}} {
      set define(action) $action_body
    }
  }

  method do {} {
    my variable domake
................................................................................
        if {$filename ne {} && ![file exists $filename]} {
          set needs_make 1
        }
      }
    }
    return $needs_make
  }

  method output {} {
    set result {}
    set filename [my define get filename]
    if {$filename ne {}} {
      lappend result $filename
    }
    foreach filename [my define get files] {
................................................................................

  method reset {} {
    my variable triggered domake needs_make
    set triggerd 0
    set domake 0
    set needs_make 0
  }

  method triggers {} {
    my variable triggered domake define
    if {$triggered} {
      return $domake
    }
    set triggered 1
    set make_objects [my <module> make objects]
................................................................................
# START: class object.tcl
###
::oo::class create ::practcl::object {
  superclass ::practcl::metaclass

  constructor {parent args} {
    my variable links define
    set delegates [$parent child delegate]
    my clay delegate {*}$delegates
    array set define $delegates
    array set define [$parent child define]
    array set links {}
    if {[llength $args]==1 && [file exists [lindex $args 0]]} {
      my define set filename [lindex $args 0]
      ::practcl::product select [self]
    } elseif {[llength $args] == 1} {
      set data  [uplevel 1 [list subst [lindex $args 0]]]
................................................................................
        }
      }
    }
    if {$class ne {}} {
      $object morph $class
    }
    if {$mixin ne {}} {
      $object clay mixinmap product $mixin
    }
  }
}

###
# Flesh out several trivial varieties of product
###
................................................................................
        }
      }
    }
  }

  method child which {
    switch $which {
      delegate {

        return [list project [my define get project] module [self]]
      }
    }
  }

 ###
  # This methods generates the contents of an amalgamated .c file
................................................................................
    # DEFS fields need to be passed unchanged and unsubstituted
    # as we need to preserve their escape characters
    foreach field {TCL_DEFS DEFS TK_DEFS} {
      if {[dict exists $rawcontents $field]} {
        dict set contents $field [dict get $rawcontents $field]
      }
    }
    my clay delegate module [self]
    array set define $contents
    ::practcl::toolset select [self]
    my initialize
  }

  method add_object object {
    my link object $object
................................................................................
    }
    $tkobj define set config_opts $tk_config_opts
    $tkobj compile
  }

  method child which {
    switch $which {
      delegate {

	# A library can be a project, it can be a module. Any
	# subordinate modules will indicate their existance
        return [list project [self] module [self]]
      }
    }
  }

................................................................................
      return $obj
    }
    ${obj} {*}$args
  }


  method tclcore {} {
    if {[info commands [set obj [my clay delegate tclcore]]] ne {}} {
      return $obj
    }
    if {[info commands [set obj [my project TCLCORE]]] ne {}} {
      my clay delegate tclcore $obj
      return $obj
    }
    if {[info commands [set obj [my project tcl]]] ne {}} {
      my clay delegate tclcore $obj
      return $obj
    }
    if {[info commands [set obj [my tool tcl]]] ne {}} {
      my clay delegate tclcore $obj
      return $obj
    }
    # Provide a fallback
    set obj [my add_tool tcl {
      tag release class subproject.core
      fossil_url http://core.tcl.tk/tcl
    }]
    my clay delegate tclcore $obj
    return $obj
  }

  method tkcore {} {
    if {[set obj [my clay delegate tkcore]] ne {}} {
      return $obj
    }
    if {[set obj [my clay delegate tk]] ne {}} {
      my clay delegate tkcore $obj
      return $obj
    }
    if {[set obj [my tool tk]] ne {}} {
      my clay delegate tkcore $obj
      return $obj
    }
    # Provide a fallback
    set obj [my add_tool tk {
      tag release class tool.core
      fossil_url http://core.tcl.tk/tk
    }]
    my clay delegate tkcore $obj
    return $obj
  }

  method tool {pkg args} {
    set obj ::practcl::OBJECT::TOOL.$pkg
    if {[llength $args]==0} {
      return $obj
................................................................................
      scm  None
      hash {}
      maxdate {}
      tags {}
      isodate {}
    }
  }

  method DistroMixIn {} {
    my define set scm none
  }

  method Sandbox {} {
    if {[my define exists sandbox]} {
      return [my define get sandbox]
    }
    if {[my clay delegate project] ni {::noop {}}} {
      set sandbox [my <project> define get sandbox]
      if {$sandbox ne {}} {
        my define set sandbox $sandbox
        return $sandbox
      }
    }
    set sandbox [file normalize [file join $::CWD ..]]
................................................................................

oo::objdefine ::practcl::distribution {

  method Sandbox {object} {
    if {[$object define exists sandbox]} {
      return [$object define get sandbox]
    }
    if {[$object clay delegate project] ni {::noop {}}} {
      set sandbox [$object <project> define get sandbox]
      if {$sandbox ne {}} {
        $object define set sandbox $sandbox
        return $sandbox
      }
    }
    set pkg [$object define get name]
................................................................................
      $object define set srcdir $srcdir
    }

    set classprefix ::practcl::distribution.
    if {[file exists $srcdir]} {
      foreach class [::info commands ${classprefix}*] {
        if {[$class claim_path $srcdir]} {
          $object clay mixinmap distribution $class
          $object define set scm [string range $class [string length ::practcl::distribution.] end]
          return [$object define get scm]
        }
      }
    }
    foreach class [::info commands ${classprefix}*] {
      if {[$class claim_object $object]} {
        $object clay mixinmap distribution $class
        $object define set scm [string range $class [string length ::practcl::distribution.] end]
        return [$object define get scm]
      }
    }
    if {[$object define get scm] eq {} && [$object define exists file_url]} {
      set class ::practcl::distribution.snapshot
      $object define set scm snapshot
      $object clay mixinmap distribution $class
      return [$object define get scm]
    }
    error "Cannot determine source distribution method"
  }

  method claim_path path {
    return false
................................................................................

  method BuildDir {PWD} {
    return [my define get srcdir]
  }

  method child which {
    switch $which {
      delegate {

	# A library can be a project, it can be a module. Any
	# subordinate modules will indicate their existance
        return [list project [self] module [self]]
      }
    }
  }







|







 







>
>
>







 







<
<
<
<
|
|


<
>



|


|










|







 







<
<

|

<
>

|






|
<
<
<
<
<
<










>
>
>
>
>
>







 







>
>
>
>







 







|







 







|
>
>












|
>

<
<
<
<
<









>
>
>
>







 







|












|



|







 







|







 







|


|

|







 







|
>
>







 







|







 







|







 







|
|
|







 







|







 







|
>







 







|







 







|
>







 







|



|



|



|







|




|


|
|



|







|







 







|








|







 







|







 







|







|







|







 







|
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
..
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
...
523
524
525
526
527
528
529




530
531
532
533

534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
...
733
734
735
736
737
738
739


740
741
742

743
744
745
746
747
748
749
750
751
752






753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
....
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
....
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
....
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155





2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
....
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
....
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
....
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
....
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
....
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
....
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
....
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
....
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
....
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848
....
5084
5085
5086
5087
5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
....
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
....
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251
5252
5253
5254
5255
5256
....
5977
5978
5979
5980
5981
5982
5983
5984
5985
5986
5987
5988
5989
5990
5991
5992
5993
5994
5995
5996
5997
5998
5999
6000
....
6039
6040
6041
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052
6053
....
6069
6070
6071
6072
6073
6074
6075
6076
6077
6078
6079
6080
6081
6082
6083
6084
6085
6086
6087
6088
6089
6090
6091
6092
6093
6094
6095
6096
6097
6098
6099
....
6395
6396
6397
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
###
# Amalgamated package for practcl
# Do not edit directly, tweak the source in src/ and rerun
# build.tcl
###
package require Tcl 8.5
package provide practcl 0.12
namespace eval ::practcl {}

###
# START: httpwget/wget.tcl
###
###
# Tool to download file from the web
................................................................................

###
# END: httpwget/wget.tcl
###
###
# START: clay/build/procs.tcl
###
::namespace eval ::clay {}
set ::clay::trace 0

###
# Global utilities
###
if {[info commands ::ladd] eq {}} {
  proc ladd {varname args} {
    upvar 1 $varname var
    if ![info exists var] {
................................................................................
              return $value
            }
          }
        }
        return {}
      }
      delegate {




        if {![dict exists $clay delegate/ <class>]} {
          dict set clay delegate/ <class> [info object class [self]]
        }
        if {[llength $args]==0} {

          return [dict get $clay delegate/]
        }
        if {[llength $args]==1} {
          set stub <[string trim [lindex $args 0] <>]>
          if {![dict exists $clay delegate/ $stub]} {
            return {}
          }
          return [dict get $clay delegate/ $stub]
        }
        if {([llength $args] % 2)} {
          error "Usage: delegate
    OR
    delegate stub
    OR
    delegate stub OBJECT ?stub OBJECT? ..."
        }
        foreach {stub object} $args {
          set stub <[string trim $stub <>]>
          dict set clay delegate/ $stub $object
          oo::objdefine [self] forward ${stub} $object
          oo::objdefine [self] export ${stub}
        }
      }
      dump {
        # Do a full dump of clay data
        set result $clay
................................................................................
              puts stderr "[self] MIXIN ERROR PEEKING $class:\n[dict get $errdat -errorinfo]"
            }
            break
          }
        }
      }
      mixinmap {


        foreach {slot classes} $args {
          dict set clay mixin/ $slot $classes
        }

        set claycache {}
        set classlist {}
        foreach {item class} [my clay get mixin/] {
          if {$class ne {}} {
            lappend classlist $class
          }
        }
        my clay mixin {*}$classlist
      }
      provenance {






        if {[dict exists $clay {*}$args]} {
          return self
        }
        foreach class $clayorder {
          if {[$class clay exists {*}$args]} {
            return $class
          }
        }
        return {}
      }
      replace {
        set clay [lindex $args 0]
      }
      source {
        source [lindex $args 0]
      }
      set {
        #puts [list [self] clay SET {*}$args]
        ::clay::dictmerge clay {*}$args
      }
      default {
        dict $submethod clay {*}$args
      }
................................................................................
        }
      }
      default {
        array $submethod define {*}$args
      }
    }
  }

  method graft args {
    return [my clay delegate {*}$args]
  }

  method initialize {} {}


  method link {command args} {
    my variable links
    switch $command {
................................................................................
      } {
        if {[string match $pattern $class]} {
           set mixinslot $slot
           break
        }
      }
      if {$mixinslot ne {}} {
        my mixin $mixinslot $class
      } elseif {[info command $class] ne {}} {
        if {[info object class [self]] ne $class} {
          ::oo::objdefine [self] class $class
          ::practcl::debug [self] morph $class
           my define set class $class
        }
      } else {
................................................................................
    }
    if {[::info exists define(oodefine)]} {
      ::oo::objdefine [self] $define(oodefine)
      #unset define(oodefine)
    }
  }

  method mixin {slot classname} {
    my variable mixinslot
    set class {}
    set map [list @slot@ $slot @name@ $classname]
    foreach pattern [split [string map $map {
      @name@
      @slot@.@name@
      ::practcl::@name@
      ::practcl::@slot@.@name@
      ::practcl::@slot@*@name@
      ::practcl::*@name@*
    }] \n] {
      set pattern [string trim $pattern]
      set matches [info commands $pattern]
      if {![llength $matches]} continue
      set class [lindex $matches 0]
      break
    }





    ::practcl::debug [self] mixin $slot $class
    dict set mixinslot $slot $class
    set mixins {}
    foreach {s c} $mixinslot {
      if {$c eq {}} continue
      lappend mixins $c
    }
    oo::objdefine [self] mixin {*}$mixins
  }

  method organ args {
    return [my clay delegate {*}$args]
  }

  method script script {
    eval $script
  }

  method select {} {
    my variable define
................................................................................
oo::class create ::practcl::toolset {
  ###
  # find or fake a key/value list describing this project
  ###
  method config.sh {} {
    return [my read_configuration]
  }
  
  method BuildDir {PWD} {
    set name [my define get name]
    set debug [my define get debug 0]
    if {[my <project> define get LOCAL 0]} {
      return [my define get builddir [file join $PWD local $name]]
    }
    if {$debug} {
      return [my define get builddir [file join $PWD debug $name]]
    } else {
      return [my define get builddir [file join $PWD pkg $name]]
    }
  }
  
  method MakeDir {srcdir} {
    return $srcdir
  }
  
  method read_configuration {} {
    my variable conf_result
    if {[info exists conf_result]} {
      return $conf_result
    }
    set result {}
    set name [my define get name]
................................................................................
    }
    set srcdir [my SourceRoot]
    set PWD [pwd]
    cd $srcdir
    ::practcl::dotclexec $critcl {*}$args
    cd $PWD
  }
  
  method make-autodetect {} {}
}


oo::objdefine ::practcl::toolset {


................................................................................
    # Select the toolset to use for this project
    ###
    if {[$object define exists toolset]} {
      return [$object define get toolset]
    }
    set class [$object define get toolset]
    if {$class ne {}} {
      $object mixin toolset $class
    } else {
      if {[info exists ::env(VisualStudioVersion)]} {
        $object mixin toolset ::practcl::toolset.msvc
      } else {
        $object mixin toolset ::practcl::toolset.gcc
      }
    }
  }
}

###
# END: class toolset baseclass.tcl
................................................................................
    set triggered 0
    set domake 0
    set define(name) $name
    set define(action) {}
    array set define $info
    my select
    my initialize
    foreach {stub obj} [$module_object child organs] {
      my graft $stub $obj
    }
    if {$action_body ne {}} {
      set define(action) $action_body
    }
  }

  method do {} {
    my variable domake
................................................................................
        if {$filename ne {} && ![file exists $filename]} {
          set needs_make 1
        }
      }
    }
    return $needs_make
  }
  
  method output {} {
    set result {}
    set filename [my define get filename]
    if {$filename ne {}} {
      lappend result $filename
    }
    foreach filename [my define get files] {
................................................................................

  method reset {} {
    my variable triggered domake needs_make
    set triggerd 0
    set domake 0
    set needs_make 0
  }
  
  method triggers {} {
    my variable triggered domake define
    if {$triggered} {
      return $domake
    }
    set triggered 1
    set make_objects [my <module> make objects]
................................................................................
# START: class object.tcl
###
::oo::class create ::practcl::object {
  superclass ::practcl::metaclass

  constructor {parent args} {
    my variable links define
    set organs [$parent child organs]
    my clay delegate {*}$organs
    array set define $organs
    array set define [$parent child define]
    array set links {}
    if {[llength $args]==1 && [file exists [lindex $args 0]]} {
      my define set filename [lindex $args 0]
      ::practcl::product select [self]
    } elseif {[llength $args] == 1} {
      set data  [uplevel 1 [list subst [lindex $args 0]]]
................................................................................
        }
      }
    }
    if {$class ne {}} {
      $object morph $class
    }
    if {$mixin ne {}} {
      $object mixin product $mixin
    }
  }
}

###
# Flesh out several trivial varieties of product
###
................................................................................
        }
      }
    }
  }

  method child which {
    switch $which {
      delegate -
      organs {
        return [list project [my define get project] module [self]]
      }
    }
  }

 ###
  # This methods generates the contents of an amalgamated .c file
................................................................................
    # DEFS fields need to be passed unchanged and unsubstituted
    # as we need to preserve their escape characters
    foreach field {TCL_DEFS DEFS TK_DEFS} {
      if {[dict exists $rawcontents $field]} {
        dict set contents $field [dict get $rawcontents $field]
      }
    }
    my graft module [self]
    array set define $contents
    ::practcl::toolset select [self]
    my initialize
  }

  method add_object object {
    my link object $object
................................................................................
    }
    $tkobj define set config_opts $tk_config_opts
    $tkobj compile
  }

  method child which {
    switch $which {
      delegate -
      organs {
	# A library can be a project, it can be a module. Any
	# subordinate modules will indicate their existance
        return [list project [self] module [self]]
      }
    }
  }

................................................................................
      return $obj
    }
    ${obj} {*}$args
  }


  method tclcore {} {
    if {[info commands [set obj [my organ tclcore]]] ne {}} {
      return $obj
    }
    if {[info commands [set obj [my project TCLCORE]]] ne {}} {
      my graft tclcore $obj
      return $obj
    }
    if {[info commands [set obj [my project tcl]]] ne {}} {
      my graft tclcore $obj
      return $obj
    }
    if {[info commands [set obj [my tool tcl]]] ne {}} {
      my graft tclcore $obj
      return $obj
    }
    # Provide a fallback
    set obj [my add_tool tcl {
      tag release class subproject.core
      fossil_url http://core.tcl.tk/tcl
    }]
    my graft tclcore $obj
    return $obj
  }

  method tkcore {} {
    if {[set obj [my organ tkcore]] ne {}} {
      return $obj
    }
    if {[set obj [my project tk]] ne {}} {
      my graft tkcore $obj
      return $obj
    }
    if {[set obj [my tool tk]] ne {}} {
      my graft tkcore $obj
      return $obj
    }
    # Provide a fallback
    set obj [my add_tool tk {
      tag release class tool.core
      fossil_url http://core.tcl.tk/tk
    }]
    my graft tkcore $obj
    return $obj
  }

  method tool {pkg args} {
    set obj ::practcl::OBJECT::TOOL.$pkg
    if {[llength $args]==0} {
      return $obj
................................................................................
      scm  None
      hash {}
      maxdate {}
      tags {}
      isodate {}
    }
  }
  
  method DistroMixIn {} {
    my define set scm none
  }

  method Sandbox {} {
    if {[my define exists sandbox]} {
      return [my define get sandbox]
    }
    if {[my organ project] ni {::noop {}}} {
      set sandbox [my <project> define get sandbox]
      if {$sandbox ne {}} {
        my define set sandbox $sandbox
        return $sandbox
      }
    }
    set sandbox [file normalize [file join $::CWD ..]]
................................................................................

oo::objdefine ::practcl::distribution {

  method Sandbox {object} {
    if {[$object define exists sandbox]} {
      return [$object define get sandbox]
    }
    if {[$object organ project] ni {::noop {}}} {
      set sandbox [$object <project> define get sandbox]
      if {$sandbox ne {}} {
        $object define set sandbox $sandbox
        return $sandbox
      }
    }
    set pkg [$object define get name]
................................................................................
      $object define set srcdir $srcdir
    }

    set classprefix ::practcl::distribution.
    if {[file exists $srcdir]} {
      foreach class [::info commands ${classprefix}*] {
        if {[$class claim_path $srcdir]} {
          $object mixin distribution $class
          $object define set scm [string range $class [string length ::practcl::distribution.] end]
          return [$object define get scm]
        }
      }
    }
    foreach class [::info commands ${classprefix}*] {
      if {[$class claim_object $object]} {
        $object mixin distribution $class
        $object define set scm [string range $class [string length ::practcl::distribution.] end]
        return [$object define get scm]
      }
    }
    if {[$object define get scm] eq {} && [$object define exists file_url]} {
      set class ::practcl::distribution.snapshot
      $object define set scm snapshot
      $object mixin distribution $class
      return [$object define get scm]
    }
    error "Cannot determine source distribution method"
  }

  method claim_path path {
    return false
................................................................................

  method BuildDir {PWD} {
    return [my define get srcdir]
  }

  method child which {
    switch $which {
      delegate -
      organs {
	# A library can be a project, it can be a module. Any
	# subordinate modules will indicate their existance
        return [list project [self] module [self]]
      }
    }
  }