Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Updated clay and httpd from tcllib |
---|---|
Timelines: | family | ancestors | descendants | both | clay |
Files: | files | file ages | folders |
SHA1: |
c0972ee07cf5be78a893e24c6faa5dcd |
User & Date: | hypnotoad 2018-10-30 23:28:45.196 |
Context
2020-01-07
| ||
17:22 | Merging changes from trunk. Updating Clay to the latest version check-in: efd3e0dcbd user: hypnotoad tags: clay | |
2018-10-30
| ||
23:28 | Updated clay and httpd from tcllib check-in: c0972ee07c user: hypnotoad tags: clay | |
2018-10-24
| ||
00:13 | Replaced sak with Practcl installation manager check-in: 7c1b4765ca user: hypnotoad tags: clay | |
Changes
Changes to modules/clay-db/build/schema.tcl.
︙ | ︙ | |||
29 30 31 32 33 34 35 | ### return [string compare -nocase $a $b] } ::clay::define ::clay-db::meta.schema { Variable table_objs {} | | | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 | ### return [string compare -nocase $a $b] } ::clay::define ::clay-db::meta.schema { Variable table_objs {} Class_Method schema args { if {[lindex $args 0] eq "<list>"} { return [my clay keys schema/] } return [my clay set schema/ {*}$args] } # Properties that need to be set: |
︙ | ︙ |
Changes to modules/clay-db/clay-db.tcl.
︙ | ︙ | |||
54 55 56 57 58 59 60 | ### return [string compare -nocase $a $b] } ::clay::define ::clay-db::meta.schema { Variable table_objs {} | | | 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 | ### return [string compare -nocase $a $b] } ::clay::define ::clay-db::meta.schema { Variable table_objs {} Class_Method schema args { if {[lindex $args 0] eq "<list>"} { return [my clay keys schema/] } return [my clay set schema/ {*}$args] } # Properties that need to be set: |
︙ | ︙ |
Changes to modules/clay-ui/build/baseclass.tcl.
︙ | ︙ | |||
57 58 59 60 61 62 63 | real 0 number 0 date 0 complex 0 boolean 0 } | | | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | real 0 number 0 date 0 complex 0 boolean 0 } Class_Method register {name body} { ::clay::define ::clay::ui::datatype::$name $body set ::clay::ui::datatype::regen 1 } Option_Class organ { widget label set-command {my graft %field% %value%} |
︙ | ︙ |
Changes to modules/clay-ui/clay-ui.tcl.
︙ | ︙ | |||
69 70 71 72 73 74 75 | real 0 number 0 date 0 complex 0 boolean 0 } | | | 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 | real 0 number 0 date 0 complex 0 boolean 0 } Class_Method register {name body} { ::clay::define ::clay::ui::datatype::$name $body set ::clay::ui::datatype::regen 1 } Option_Class organ { widget label set-command {my graft %field% %value%} |
︙ | ︙ |
Changes to modules/clay/build/build.tcl.
︙ | ︙ | |||
56 57 58 59 60 61 62 | # Track what files we have included so far set loaded {} lappend loaded build.tcl test.tcl foreach {omod files} { uuid {uuid.tcl} oodialect {oodialect.tcl} | | | 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 | # Track what files we have included so far set loaded {} lappend loaded build.tcl test.tcl foreach {omod files} { uuid {uuid.tcl} oodialect {oodialect.tcl} dicttool {dicttool.tcl} } { foreach file $files { set content [::practcl::cat [file join $moddir .. $omod {*}$file]] #AutoDoc scan_text $content puts $fout "###\n# START: [file join $omod $file]\n###" puts $fout [::practcl::docstrip $content] puts $fout "###\n# END: [file join $omod $file]\n###" |
︙ | ︙ |
Changes to modules/clay/build/core.tcl.
1 2 | package require Tcl 8.6 ;# try in pipeline.tcl. Possibly other things. package require TclOO | | | | | 1 2 3 4 5 6 7 8 9 10 11 | package require Tcl 8.6 ;# try in pipeline.tcl. Possibly other things. package require TclOO #package require uuid #package require dicttool 1.2 #package require oo::dialect ::oo::dialect::create ::clay ::namespace eval ::clay {} ::namespace eval ::clay::classes {} ::namespace eval ::clay::define {} |
Changes to modules/clay/build/metaclass.tcl.
︙ | ︙ | |||
69 70 71 72 73 74 75 | } append body $rawbody set class [current_class] ::oo::define $class constructor $arglist $body } ### | < | > > > > > > > > | 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 | } append body $rawbody set class [current_class] ::oo::define $class constructor $arglist $body } ### # Specify the a method for the class object itself, instead of for objects of the class ### proc ::clay::define::Class_Method {name arglist body} { set class [current_class] $class clay set class_typemethod/ [string trim $name :/] [dict create arglist $arglist body $body] } ### # And alias to the new Class_Method keyword ### proc ::clay::define::class_method {name arglist body} { set class [current_class] $class clay set class_typemethod/ [string trim $name :/] [dict create arglist $arglist body $body] } proc ::clay::define::clay {args} { |
︙ | ︙ |
Changes to modules/clay/build/object.tcl.
︙ | ︙ | |||
75 76 77 78 79 80 81 | ### method clay {submethod args} { my variable clay claycache clayorder config option_canonical if {![info exists clay]} {set clay {}} if {![info exists claycache]} {set claycache {}} if {![info exists config]} {set config {}} if {![info exists clayorder] || [llength $clayorder]==0} { | | | 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 | ### method clay {submethod args} { my variable clay claycache clayorder config option_canonical if {![info exists clay]} {set clay {}} if {![info exists claycache]} {set claycache {}} if {![info exists config]} {set config {}} if {![info exists clayorder] || [llength $clayorder]==0} { set clayorder [::clay::ancestors [info object class [self]] {*}[lreverse [info object mixins [self]]]] } switch $submethod { ancestors { return $clayorder } branch { set path [::dicttool::storage $args] |
︙ | ︙ | |||
233 234 235 236 237 238 239 | return $count } } return 0 } flush { set claycache {} | | < > | | < > | < < < < | < | < < < < | < > | < | > | < < < | | < | | < < > > > > | 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 | return $count } } return 0 } flush { set claycache {} set clayorder [::clay::ancestors [info object class [self]] {*}[lreverse [info object mixins [self]]]] } forward { oo::objdefine [self] forward {*}$args } dget { set path [::dicttool::storage $args] if {[llength $path]==0} { # Do a full dump of clay data set result {} # Search in the in our list of classes for an answer foreach class $clayorder { ::dicttool::dictmerge result [$class clay dump] } ::dicttool::dictmerge result $clay return $result } # Search in our local cache if {[dict exists $claycache {*}$path .]} { return [dict get $claycache {*}$path] } if {[dict exists $claycache {*}$path]} { return [dict get $claycache {*}$path] } if {[dict exists $clay {*}$path] && ![dict exists $clay {*}$path .]} { # Path is a leaf return [dict get $clay {*}$path] } set found 0 set branch [dict exists $clay {*}$path .] foreach class $clayorder { if {[$class clay exists {*}$path .]} { set found 1 break } if {!$branch && [$class clay exists {*}$path]} { set result [$class clay dget {*}$path] dict set claycache {*}$path $result return $result } } # Path is a branch set result [dict getnull $clay {*}$path] foreach class $clayorder { if {![$class clay exists {*}$path .]} continue ::dicttool::dictmerge result [$class clay dget {*}$path] } #if {[dict exists $clay {*}$path .]} { # ::dicttool::dictmerge result #} dict set claycache {*}$path $result return $result } getnull - get { set path [::dicttool::storage $args] if {[llength $path]==0} { # Do a full dump of clay data set result {} # Search in the in our list of classes for an answer foreach class $clayorder { ::dicttool::dictmerge result [$class clay dump] } ::dicttool::dictmerge result $clay return [::dicttool::sanitize $result] } # Search in our local cache if {[dict exists $claycache {*}$path .]} { return [::dicttool::sanitize [dict get $claycache {*}$path]] } if {[dict exists $claycache {*}$path]} { return [dict get $claycache {*}$path] } if {[dict exists $clay {*}$path] && ![dict exists $clay {*}$path .]} { |
︙ | ︙ | |||
335 336 337 338 339 340 341 | if {!$branch && [$class clay exists {*}$path]} { set result [$class clay dget {*}$path] dict set claycache {*}$path $result return $result } } # Path is a branch | | | | | > > > | | < | | < > | 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 | if {!$branch && [$class clay exists {*}$path]} { set result [$class clay dget {*}$path] dict set claycache {*}$path $result return $result } } # Path is a branch set result [dict getnull $clay {*}$path] #foreach class [lreverse $clayorder] { # if {![$class clay exists {*}$path .]} continue # ::dicttool::dictmerge result [$class clay dget {*}$path] #} foreach class $clayorder { if {![$class clay exists {*}$path .]} continue ::dicttool::dictmerge result [$class clay dget {*}$path] } #if {[dict exists $clay {*}$path .]} { # ::dicttool::dictmerge result [dict get $clay {*}$path] #} dict set claycache {*}$path $result return [dicttool::sanitize $result] } leaf { # Leaf searches return one data field at a time # Search in our local dict set path [::dicttool::storage $args] |
︙ | ︙ | |||
435 436 437 438 439 440 441 | dict set clay .mixin {} } if {[llength $args]==0} { return [dict get $clay .mixin] } elseif {[llength $args]==1} { return [dict getnull $clay .mixin [lindex $args 0]] } else { | | < | | 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 | dict set clay .mixin {} } if {[llength $args]==0} { return [dict get $clay .mixin] } elseif {[llength $args]==1} { return [dict getnull $clay .mixin [lindex $args 0]] } else { dict for {slot classes} $args { dict set clay .mixin $slot $classes } set classlist {} dict for {item class} [dict get $clay .mixin] { if {$class ne {}} { lappend classlist $class } } my clay mixin {*}[lreverse $classlist] } } |
︙ | ︙ | |||
482 483 484 485 486 487 488 | ### # Instantiate variables. Called on object creation and during clay mixin. ### method InitializePublic {} { my variable clayorder clay claycache config option_canonical set claycache {} | | | 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 | ### # Instantiate variables. Called on object creation and during clay mixin. ### method InitializePublic {} { my variable clayorder clay claycache config option_canonical set claycache {} set clayorder [::clay::ancestors [info object class [self]] {*}[lreverse [info object mixins [self]]]] if {![info exists clay]} { set clay {} } if {![info exists config]} { set config {} } dict for {var value} [my clay get variable] { |
︙ | ︙ |
Changes to modules/clay/build/procs.tcl.
1 2 3 | namespace eval ::clay {} set ::clay::trace 0 | > > > > > > > > > > > | | < | | | > > | | | > > | | > > | | < | | | | > > > > | < > | 1 2 3 4 5 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 38 39 40 41 42 43 44 45 46 47 48 49 50 51 | namespace eval ::clay {} set ::clay::trace 0 proc ::clay::_ancestors {resultvar class} { upvar 1 $resultvar result if {$class in $result} { return } lappend result $class foreach aclass [::info class superclasses $class] { _ancestors result $aclass } } proc ::clay::ancestors {args} { set result {} set queue {} set metaclasses {} foreach class $args { set ancestors($class) {} _ancestors ancestors($class) $class } foreach class [lreverse $args] { foreach aclass $ancestors($class) { if {$aclass in $result} continue set skip 0 foreach bclass $args { if {$class eq $bclass} continue if {$aclass in $ancestors($bclass)} { set skip 1 break } } if {$skip} continue lappend result $aclass } } foreach class [lreverse $args] { foreach aclass $ancestors($class) { if {$aclass in $result} continue lappend result $aclass } } ### # Screen out classes that do not participate in clay # interactions ### set output {} foreach {item} $result { if {[catch {$item clay noop} err]} { |
︙ | ︙ |
Changes to modules/clay/build/test.tcl.
︙ | ︙ | |||
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | set ::clay::trace 0 } putb result { # Modification History: ### # Modification 2018-10-21 # The clay metaclass no longer exports the clay method # to oo::class and oo::object, and clay::ancestors no # longer returns any class that lacks the clay method ### # Modification 2018-10-10 # clay::ancestors now rigged to descend into all classes depth-first # and then place metaclasses at the end of the search ### # ------------------------------------------------------------------------- ::oo::dialect::create ::alpha proc ::alpha::define::is_alpha {} { dict set ::testinfo([current_class]) is_alpha 1 } | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 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 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 | set ::clay::trace 0 } putb result { # Modification History: ### # Modification 2018-10-30 # Fixed an error in our ancestry mapping and developed tests to # ensure we are actually following in the order TclOO follows methods ### # Modification 2018-10-21 # The clay metaclass no longer exports the clay method # to oo::class and oo::object, and clay::ancestors no # longer returns any class that lacks the clay method ### # Modification 2018-10-10 # clay::ancestors now rigged to descend into all classes depth-first # and then place metaclasses at the end of the search ### # ------------------------------------------------------------------------- # ------------------------------------------------------------------------- # Test Helpers ### proc dict_compare {a b} { set result {} set A {} dict for {f v} $a { set f [string trim $f :/] if {$f eq {.}} continue dict set A $f $v } set B {} dict for {f v} $b { set f [string trim $f :/] if {$f eq {.}} continue dict set B $f $v } dict for {f v} $A { if {[dict exists $B $f]} { if {[dict get $B $f] ne $v} { lappend result [list B $f [dict get $B $f] [list != $v]] } } else { lappend result [list B $f $v missing] } } dict for {f v} $B { if {![dict exists $A $f]} { lappend result [list A $f $v missing] } } return $result } test dict-compare-001 {Test our testing method} { dict_compare {} {} } {} test dict-compare-002 {Test our testing method} { dict_compare {a 1} {} } {{B a 1 missing}} test dict-compare-003 {Test our testing method} { dict_compare {a 1 b 2} {a 1 b 2} } {} test dict-compare-003.a {Test our testing method} { dict_compare {a 1 b 2} {b 2 a 1 } } {} test dict-compare-003.b {Test our testing method} { dict_compare {b 2 a 1} {a 1 b 2} } {} test dict-compare-004 {Test our testing method} { dict_compare {a: 1 b: 2} {a 1 b 2} } {} test dict-compare-005 {Test our testing method} { dict_compare {a 1 b 3} {a 1 b 2} } {{B b 2 {!= 3}}} ::oo::dialect::create ::alpha proc ::alpha::define::is_alpha {} { dict set ::testinfo([current_class]) is_alpha 1 } |
︙ | ︙ | |||
185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 | ### # Test modified 2018-10-21 ### test oodialect-ancestry-005 {Testing heritage} { ::clay::ancestors ::delta::object } {} # ------------------------------------------------------------------------- # clay submodule testing # ------------------------------------------------------------------------- # Test canonical path building set path {const/ foo/ bar/ baz/} } set testnum 0 foreach {pattern} { {const foo bar baz} {const/ foo/ bar/ baz} | > > > > > > | 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 | ### # Test modified 2018-10-21 ### test oodialect-ancestry-005 {Testing heritage} { ::clay::ancestors ::delta::object } {} } putb result { # ------------------------------------------------------------------------- # clay submodule testing # ------------------------------------------------------------------------- } putb result { # Test canonical path building set path {const/ foo/ bar/ baz/} } set testnum 0 foreach {pattern} { {const foo bar baz} {const/ foo/ bar/ baz} |
︙ | ︙ | |||
395 396 397 398 399 400 401 | dict set map %object2% MIXINA dict set map %top% $top dict set map %child% $child dict set map %value% $value dict set map %testnum% [format %04d [incr testnum]] putb result $map { | | | | 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 | dict set map %object2% MIXINA dict set map %top% $top dict set map %child% $child dict set map %value% $value dict set map %testnum% [format %04d [incr testnum]] putb result $map { test oo-object-clay-method-native-%testnum% {Test native object gets the property %top%/%child%} { $%object1% clay get %top% %child% } {%value%} test oo-object-clay-method-mixin-%testnum% {Test mixin object gets the property %top%/%child%} { $%object2% clay get %top% %child% } {%value%} } } } putb result {# ------------------------------------------------------------------------- |
︙ | ︙ | |||
425 426 427 428 429 430 431 | dict set map %object2% MIXINB dict set map %top% $top dict set map %child% $child dict set map %value% $value dict set map %testnum% [format %04d [incr testnum]] putb result $map { | | | > | | 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 | dict set map %object2% MIXINB dict set map %top% $top dict set map %child% $child dict set map %value% $value dict set map %testnum% [format %04d [incr testnum]] putb result $map { test oo-object-clay-method-native-%testnum% {Test native object gets the property %top%/%child%} { $%object1% clay get %top% %child% } {%value%} test oo-object-clay-method-mixin-%testnum% {Test mixin object gets the property %top%/%child%} { $%object2% clay get %top% %child% } {%value%} } } } putb result {# ------------------------------------------------------------------------- # OBJECT descended from ::foo::classa ::foo::classb set OBJECTAB [::foo::class.ab new] # Object where classes were mixed in ::foo::classa ::foo::classb set MIXINAB [::oo::object new] # Test modified 2018-10-30, mixin order was wrong before oo::objdefine $MIXINAB mixin ::foo::classb ::foo::classa } set matrix ${claydict-b} foreach {top children} ${claydict-a} { foreach {child value} $children { if {![dict exists $matrix $top $child]} { dict set matrix $top $child $value } |
︙ | ︙ | |||
462 463 464 465 466 467 468 | dict set map %object2% MIXINAB dict set map %top% $top dict set map %child% $child dict set map %value% $value dict set map %testnum% [format %04d [incr testnum]] putb result $map { | | | > | | 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 561 562 563 564 565 566 | dict set map %object2% MIXINAB dict set map %top% $top dict set map %child% $child dict set map %value% $value dict set map %testnum% [format %04d [incr testnum]] putb result $map { test oo-object-clay-method-native-%testnum% {Test native object gets the property %top%/%child%} { $%object1% clay get %top% %child% } {%value%} test oo-object-clay-method-mixin-%testnum% {Test mixin object gets the property %top%/%child%} { $%object2% clay get %top% %child% } {%value%} } } } putb result {# ------------------------------------------------------------------------- # OBJECT descended from ::foo::classb ::foo::classa set OBJECTBA [::foo::class.ba new] # Object where classes were mixed in ::foo::classb ::foo::classa set MIXINBA [::oo::object new] # Test modified 2018-10-30, mixin order was wrong before oo::objdefine $MIXINBA mixin ::foo::classa ::foo::classb } set matrix ${claydict-a} foreach {top children} ${claydict-b} { foreach {child value} $children { if {![dict exists $matrix $top $child]} { dict set matrix $top $child $value } |
︙ | ︙ | |||
846 847 848 849 850 851 852 | test clay-mixin-e-0002 {Test that an ensemble is created during a mixin} { $OBJ which sound } {meow} test clay-mixin-e-0003 {Test that an ensemble is created during a mixin} \ -body {$OBJ which flavor} -returnCodes {error} \ -result {unknown method which flavor. Valid: color sound} ### | | | | | | 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 | test clay-mixin-e-0002 {Test that an ensemble is created during a mixin} { $OBJ which sound } {meow} test clay-mixin-e-0003 {Test that an ensemble is created during a mixin} \ -body {$OBJ which flavor} -returnCodes {error} \ -result {unknown method which flavor. Valid: color sound} ### # Test Modified: 2018-10-30, 2018-10-21, 2018-10-10 ### test clay-mixin-e-0004 {Test that clay data follows the rules of inheritence and order of mixin} { $OBJ clay ancestors } {::TEST::species.cat ::TEST::animal ::TEST::thing ::clay::object} $OBJ clay mixinmap coloring ::TEST::coloring.calico test clay-mixin-f-0001 {Test that an ensemble is created during a mixin} { $OBJ which color } {calico} test clay-mixin-f-0002 {Test that an ensemble is created during a mixin} { $OBJ which sound } {meow} test clay-mixin-f-0003 {Test that an ensemble is created during a mixin} \ -body {$OBJ which flavor} -returnCodes {error} \ -result {unknown method which flavor. Valid: color sound} ### # Test modified 2018-10-30, 2018-10-21, 2018-10-10 ### test clay-mixin-f-0004 {Test that clay data follows the rules of inheritence and order of mixin} { $OBJ clay ancestors } {::TEST::coloring.calico ::TEST::species.cat ::TEST::animal ::TEST::thing ::clay::object} test clay-mixin-f-0005 {Test that clay data from a mixin works} { $OBJ clay provenance color } {::TEST::coloring.calico} ### # Test variable initialization |
︙ | ︙ | |||
891 892 893 894 895 896 897 898 899 | } set OBJ [::TEST::has_var new] test clay-class-variable-0001 {Test that the parser injected the right value in the right place for clay to catch it} { $OBJ clay get variable/ my_variable } {10} test clay-class-variable-0002 {Test that the parser injected the right value in the right place for clay to catch it} { $OBJ clay get variable | > | > | | 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 | } set OBJ [::TEST::has_var new] test clay-class-variable-0001 {Test that the parser injected the right value in the right place for clay to catch it} { $OBJ clay get variable/ my_variable } {10} # Modified 2018-10-30 (order is different) test clay-class-variable-0002 {Test that the parser injected the right value in the right place for clay to catch it} { $OBJ clay get variable } {my_variable 10 DestroyEvent 0} # Modified 2018-10-30 (order is different) test clay-class-variable-0003 {Test that the parser injected the right value in the right place for clay to catch it} { $OBJ clay dget variable } {. {} my_variable 10 DestroyEvent 0} test clay-class-variable-0004 {Test that variables declared in the class definition are initialized} { $OBJ get_my_variable } 10 ### # Test array initialization |
︙ | ︙ | |||
940 941 942 943 944 945 946 947 948 949 | ::TEST::has_more_array clay get array } {my_array {color blue}} test clay-class-array-0009 {Test that the parser injected the right value in the right place for clay to catch it} { ::TEST::has_more_array clay find array } {my_array {timeout 10 color blue}} set BOBJ [::TEST::has_more_array new] test clay-class-array-0004 {Test that the parser injected the right value in the right place for clay to catch it} { $BOBJ clay get array | > | > | | 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 | ::TEST::has_more_array clay get array } {my_array {color blue}} test clay-class-array-0009 {Test that the parser injected the right value in the right place for clay to catch it} { ::TEST::has_more_array clay find array } {my_array {timeout 10 color blue}} # Modified 2018-10-30 (order is different) set BOBJ [::TEST::has_more_array new] test clay-class-array-0004 {Test that the parser injected the right value in the right place for clay to catch it} { $BOBJ clay get array } {my_array {color blue timeout 10}} # Modified 2018-10-30 (order is different) test clay-class-array-0005 {Test that the parser injected the right value in the right place for clay to catch it} { $BOBJ clay dget array } {. {} my_array {. {} color blue timeout 10}} test clay-class-arrau-0006 {Test that variables declared in the class definition are initialized} { $BOBJ get_my_array timeout } 10 test clay-class-arrau-0007 {Test that variables declared in the class definition are initialized} { $BOBJ get_my_array color } blue |
︙ | ︙ | |||
1022 1023 1024 1025 1026 1027 1028 1029 1030 | ::clay::define ::TEST::has_more_dict { superclass ::TEST::has_dict Dict my_dict {color blue} } set BOBJ [::TEST::has_more_dict new] test clay-class-dict-0004 {Test that the parser injected the right value in the right place for clay to catch it} { $BOBJ clay get dict | > | > | | 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 | ::clay::define ::TEST::has_more_dict { superclass ::TEST::has_dict Dict my_dict {color blue} } set BOBJ [::TEST::has_more_dict new] # Modified 2018-10-30 test clay-class-dict-0004 {Test that the parser injected the right value in the right place for clay to catch it} { $BOBJ clay get dict } {my_dict {color blue timeout 10}} # Modified 2018-10-30 test clay-class-dict-0005 {Test that the parser injected the right value in the right place for clay to catch it} { $BOBJ clay dget dict } {. {} my_dict {. {} color blue timeout 10}} test clay-class-dict-0006 {Test that variables declared in the class definition are initialized} { $BOBJ get_my_dict timeout } 10 test clay-class-dict-0007 {Test that variables declared in the class definition are initialized} { $BOBJ get_my_dict color |
︙ | ︙ | |||
1168 1169 1170 1171 1172 1173 1174 | putb result { ### # Class method testing ### clay::class create WidgetClass { | | | | 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 | putb result { ### # Class method testing ### clay::class create WidgetClass { Class_Method working {} { return {Works} } Class_Method unknown args { set tkpath [lindex $args 0] if {[string index $tkpath 0] eq "."} { set obj [my new $tkpath {*}[lrange $args 1 end]] $obj tkalias $tkpath return $tkpath } next {*}$args |
︙ | ︙ | |||
1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 | } {B} mixintest clay mixinmap tool {} test tool-mixinmap-004 {Test object prior to mixins} { mixintest test which } {} } ### # TESTS NEEDED: # destructor ### putb result { | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 | } {B} mixintest clay mixinmap tool {} test tool-mixinmap-004 {Test object prior to mixins} { mixintest test which } {} } ### # Test clay mixinslots ### putb result { clay::define ::clay::object { method path {} { return [self class] } } clay::define ::MixinRoot { clay set opts core root clay set opts option unset clay set opts color unset Ensemble info::root {} { return MixinRoot } Ensemble info::shade {} { return avacodo } Ensemble info::default {} { return Undefined } method did {} { return MixinRoot } method path {} { return [list [self class] {*}[next]] } } clay::define ::MixinOption1 { clay set opts option option1 Ensemble info::option {} { return MixinOption1 } Ensemble info::other {} { return MixinOption1 } method did {} { return MixinOption1 } method path {} { return [list [self class] {*}[next]] } } clay::define ::MixinOption2 { superclass ::MixinOption1 clay set opts option option2 Ensemble info::option {} { return MixinOption2 } method did {} { return MixinOption2 } method path {} { return [list [self class] {*}[next]] } } clay::define ::MixinColor1 { clay set opts color blue Ensemble info::color {} { return MixinColor1 } Ensemble info::shade {} { return blue } method did {} { return MixinColor1 } method path {} { return [list [self class] {*}[next]] } } clay::define ::MixinColor2 { clay set opts color green Ensemble info::color {} { return MixinColor2 } Ensemble info::shade {} { return green } method did {} { return MixinColor2 } method path {} { return [list [self class] {*}[next]] } } set obj [clay::object new] $obj clay mixinmap root ::MixinRoot } set testnum 0 set batnum 0 set obj {$obj} set template { test tool-prototype-%battery%-%test% {%comment%} { %obj% %method% } {%answer%} } set map {} dict set map %obj% {$obj} dict set map %battery% [format %04d [incr batnum]] dict set map %comment% {Mixin core} foreach {method answer} { {info root} {MixinRoot} {info option} {Undefined} {info color} {Undefined} {info other} {Undefined} {info shade} {avacodo} {did} {MixinRoot} {path} {::MixinRoot ::clay::object} {clay get opts} {core root option unset color unset} {clay get opts core} root {clay get opts option} unset {clay get opts color} unset {clay ancestors} {::MixinRoot ::clay::object} } { set testid [format %04d [incr testnum]] dict set map %test% $testid dict set map %method% $method dict set map %answer% $answer putb result $map $template } set testnum 0 putb result {$obj clay mixinmap option ::MixinOption1} dict set map %battery% [format %04d [incr batnum]] dict set map %comment% {Mixin option1} foreach {method answer} { {info root} {MixinRoot} {info option} {MixinOption1} {info color} {Undefined} {info other} {MixinOption1} {info shade} {avacodo} {did} {MixinOption1} {path} {::MixinOption1 ::MixinRoot ::clay::object} {clay get opts} {option option1 core root color unset} {clay get opts core} root {clay get opts option} option1 {clay get opts color} unset {clay ancestors} {::MixinOption1 ::MixinRoot ::clay::object} } { set testid [format %04d [incr testnum]] dict set map %test% $testid dict set map %method% $method dict set map %answer% $answer putb result $map $template } set testnum 0 putb result { set obj2 [clay::object new] $obj2 clay mixinmap root ::MixinRoot option ::MixinOption1 } putb result {$obj clay mixinmap option ::MixinOption1} dict set map %obj% {$obj2} dict set map %battery% [format %04d [incr batnum]] dict set map %comment% {Mixin option1 - clean object} foreach {method answer} { {info root} {MixinRoot} {info option} {MixinOption1} {info color} {Undefined} {info other} {MixinOption1} {info shade} {avacodo} {did} {MixinOption1} {path} {::MixinOption1 ::MixinRoot ::clay::object} {clay get opts} {option option1 core root color unset} {clay get opts core} root {clay get opts option} option1 {clay get opts color} unset {clay ancestors} {::MixinOption1 ::MixinRoot ::clay::object} } { set testid [format %04d [incr testnum]] dict set map %test% $testid dict set map %method% $method dict set map %answer% $answer putb result $map $template } set testnum 0 putb result {$obj clay mixinmap option ::MixinOption2} dict set map %battery% [format %04d [incr batnum]] dict set map %comment% {Mixin option2} dict set map %obj% {$obj} foreach {method answer} { {info root} {MixinRoot} {info option} {MixinOption2} {info color} {Undefined} {info other} {MixinOption1} {info shade} {avacodo} {did} {MixinOption2} {path} {::MixinOption2 ::MixinOption1 ::MixinRoot ::clay::object} {clay get opts} {option option2 core root color unset} {clay get opts core} root {clay get opts option} option2 {clay get opts color} unset {clay ancestors} {::MixinOption2 ::MixinOption1 ::MixinRoot ::clay::object} } { set testid [format %04d [incr testnum]] dict set map %test% $testid dict set map %method% $method dict set map %answer% $answer putb result $map $template } set testnum 0 putb result {$obj clay mixinmap color MixinColor1} dict set map %battery% [format %04d [incr batnum]] dict set map %comment% {Mixin color1} foreach {method answer} { {info root} {MixinRoot} {info option} {MixinOption2} {info color} {MixinColor1} {info other} {MixinOption1} {info shade} {blue} {did} {MixinColor1} {path} {::MixinColor1 ::MixinOption2 ::MixinOption1 ::MixinRoot ::clay::object} {clay get opts} {color blue option option2 core root} {clay get opts core} root {clay get opts option} option2 {clay get opts color} blue {clay ancestors} {::MixinColor1 ::MixinOption2 ::MixinOption1 ::MixinRoot ::clay::object} } { set testid [format %04d [incr testnum]] dict set map %test% $testid dict set map %method% $method dict set map %answer% $answer putb result $map $template } set testnum 0 putb result {$obj clay mixinmap color MixinColor2} dict set map %battery% [format %04d [incr batnum]] dict set map %comment% {Mixin color2} foreach {method answer} { {info root} {MixinRoot} {info option} {MixinOption2} {info color} {MixinColor2} {info other} {MixinOption1} {info shade} {green} {clay get opts} {color green option option2 core root} {clay get opts core} root {clay get opts option} option2 {clay get opts color} green {clay ancestors} {::MixinColor2 ::MixinOption2 ::MixinOption1 ::MixinRoot ::clay::object} } { set testid [format %04d [incr testnum]] dict set map %test% $testid dict set map %method% $method dict set map %answer% $answer putb result $map $template } set testnum 0 putb result {$obj clay mixinmap option MixinOption1} dict set map %battery% [format %04d [incr batnum]] dict set map %comment% {Mixin color2 + Option1} foreach {method answer} { {info root} {MixinRoot} {info option} {MixinOption1} {info color} {MixinColor2} {info other} {MixinOption1} {info shade} {green} {clay get opts} {color green option option1 core root} {clay get opts core} root {clay get opts option} option1 {clay get opts color} green {clay ancestors} {::MixinColor2 ::MixinOption1 ::MixinRoot ::clay::object} } { set testid [format %04d [incr testnum]] dict set map %test% $testid dict set map %method% $method dict set map %answer% $answer putb result $map $template } set testnum 0 putb result {$obj clay mixinmap option {}} dict set map %battery% [format %04d [incr batnum]] dict set map %comment% {Mixin color2 + no option} foreach {method answer} { {info root} {MixinRoot} {info option} {Undefined} {info color} {MixinColor2} {info other} {Undefined} {info shade} {green} {clay get opts} {color green core root option unset} {clay get opts core} root {clay get opts option} unset {clay get opts color} green {clay ancestors} {::MixinColor2 ::MixinRoot ::clay::object} } { set testid [format %04d [incr testnum]] dict set map %test% $testid dict set map %method% $method dict set map %answer% $answer putb result $map $template } set testnum 0 putb result {$obj clay mixinmap color {}} dict set map %battery% [format %04d [incr batnum]] dict set map %comment% {Mixin core (return to normal)} foreach {method answer} { {info root} {MixinRoot} {info option} {Undefined} {info color} {Undefined} {info other} {Undefined} {info shade} {avacodo} {clay get opts} {core root option unset color unset} {clay get opts core} root {clay get opts option} unset {clay get opts color} unset {clay ancestors} {::MixinRoot ::clay::object} } { set testid [format %04d [incr testnum]] dict set map %test% $testid dict set map %method% $method dict set map %answer% $answer putb result $map $template } ### # TESTS NEEDED: # destructor ### putb result { |
︙ | ︙ |
Deleted modules/clay/clay.man.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Changes to modules/httpd/build/file.tcl.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | ### # Class to deliver Static content # When utilized, this class is fed a local filename # by the dispatcher ### ::clay::define ::httpd::content.file { method FileName {} { set uri [string trimleft [my request get REQUEST_URI] /] set path [my clay get path] set prefix [my clay get prefix] set fname [string range $uri [string length $prefix] end] if {$fname in "{} index.html index.md index index.tml"} { return $path } | > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | ### # Class to deliver Static content # When utilized, this class is fed a local filename # by the dispatcher ### ::clay::define ::httpd::content.file { method FileName {} { # Some dispatchers will inject a fully qualified name during discovery if {[my clay exists FILENAME] && [file exists [my clay get FILENAME]]} { return [my clay get FILENAME] } set uri [string trimleft [my request get REQUEST_URI] /] set path [my clay get path] set prefix [my clay get prefix] set fname [string range $uri [string length $prefix] end] if {$fname in "{} index.html index.md index index.tml"} { return $path } |
︙ | ︙ |