Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Updating to the latest practcl |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | practcl |
Files: | files | file ages | folders |
SHA3-256: |
149b1e1e5f58df05dd6df8e0d3ec7163 |
User & Date: | hypnotoad 2019-07-26 13:14:21.678 |
Context
2019-09-09
| ||
13:11 |
Update Practcl.tcl to the latest
Workaround in tclZipFs for an internal API change in the Tcl Core post 8.6.9 check-in: 79972997da user: hypnotoad tags: practcl | |
2019-07-26
| ||
13:14 | Updating to the latest practcl check-in: 149b1e1e5f user: hypnotoad tags: practcl | |
2019-04-08
| ||
16:09 | Update to Practcl check-in: 4badff3c09 user: hypnotoad tags: practcl | |
Changes
Changes to practcl.tcl.
1 2 3 4 5 6 | ### # Amalgamated package for practcl # Do not edit directly, tweak the source in src/ and rerun # build.tcl ### package require Tcl 8.6 | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | 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 | ### # Amalgamated package for practcl # Do not edit directly, tweak the source in src/ and rerun # build.tcl ### package require Tcl 8.6 package provide practcl 0.16.3 namespace eval ::practcl {} ### # START: httpwget/wget.tcl ### ### # END: httpwget/wget.tcl ### ### # START: clay/clay.tcl ### package provide clay 0.8.1 namespace eval ::clay { } namespace eval ::clay { } set ::clay::trace 0 proc ::clay::PROC {name arglist body {ninja {}}} { if {[info commands $name] ne {}} return |
︙ | ︙ | |||
275 276 277 278 279 280 281 | return [uuid generate] } namespace eval ::clay { variable option_class {} variable core_classes {::oo::class ::oo::object} } package require Tcl 8.6 ;# try in pipeline.tcl. Possibly other things. | > | | > > | > > < < < < | 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 | return [uuid generate] } namespace eval ::clay { variable option_class {} variable core_classes {::oo::class ::oo::object} } package require Tcl 8.6 ;# try in pipeline.tcl. Possibly other things. if {[info commands irmmd5] eq {}} { if {[catch {package require odielibc}]} { package require md5 2 } } ::namespace eval ::clay { } ::namespace eval ::clay::classes { } ::namespace eval ::clay::define { } ::namespace eval ::clay::tree { } ::namespace eval ::clay::dict { } ::namespace eval ::clay::list { } ::namespace eval ::clay::uuid { } if {![info exists ::clay::idle_destroy]} { set ::clay::idle_destroy {} } namespace eval ::clay::uuid { namespace export uuid } proc ::clay::uuid::generate_tcl_machinfo {} { variable machinfo if {[info exists machinfo]} { return $machinfo } lappend machinfo [clock seconds]; # timestamp |
︙ | ︙ | |||
346 347 348 349 350 351 352 | # If the nettool package works on this platform # use the stream of hardware ids from it ### lappend machinfo {*}[::nettool::hwid_list] } return $machinfo } | > | | > > > | < < > > > > | | | > > > > > > > | > | | < < > | > > | > > | | > > > | 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 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 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 | # If the nettool package works on this platform # use the stream of hardware ids from it ### lappend machinfo {*}[::nettool::hwid_list] } return $machinfo } if {[info commands irmmd5] ne {}} { proc ::clay::uuid::generate {{type {}}} { variable nextuuid set s [irmmd5 "$type [incr nextuuid(type)] [generate_tcl_machinfo]"] foreach {a b} {0 7 8 11 12 15 16 19 20 31} { append r [string range $s $a $b] - } return [string tolower [string trimright $r -]] } proc ::clay::uuid::short {{type {}}} { variable nextuuid set r [irmmd5 "$type [incr nextuuid(type)] [generate_tcl_machinfo]"] return [string range $r 0 16] } } else { package require md5 2 proc ::clay::uuid::raw {{type {}}} { variable nextuuid set tok [md5::MD5Init] md5::MD5Update $tok "$type [incr nextuuid($type)] [generate_tcl_machinfo]" set r [md5::MD5Final $tok] return $r #return [::clay::uuid::tostring $r] } proc ::clay::uuid::generate {{type {}}} { return [::clay::uuid::tostring [::clay::uuid::raw $type]] } proc ::clay::uuid::short {{type {}}} { set r [::clay::uuid::raw $type] binary scan $r H* s return [string range $s 0 16] } } proc ::clay::uuid::tostring {uuid} { binary scan $uuid H* s foreach {a b} {0 7 8 11 12 15 16 19 20 31} { append r [string range $s $a $b] - } return [string tolower [string trimright $r -]] } proc ::clay::uuid::fromstring {uuid} { return [binary format H* [string map {- {}} $uuid]] } proc ::clay::uuid::equal {left right} { set l [fromstring $left] set r [fromstring $right] return [string equal $l $r] } proc ::clay::uuid {cmd args} { switch -exact -- $cmd { generate { return [::clay::uuid::generate {*}$args] } short { set uuid [::clay::uuid::short {*}$args] } equal { tailcall ::clay::uuid::equal {*}$args } default { return -code error "bad option \"$cmd\":\ must be generate or equal" |
︙ | ︙ | |||
666 667 668 669 670 671 672 | set found 1 break } } if {$found} continue } if {[dict exists $info default:]} { | | | 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 | set found 1 break } } if {$found} continue } if {[dict exists $info default:]} { set _var [dict get $info default:] continue } set mandatory 1 if {[dict exists $info mandatory:]} { set mandatory [dict get $info mandatory:] } if {$mandatory} { |
︙ | ︙ | |||
918 919 920 921 922 923 924 | } } } } namespace eval ::clay::dialect { variable core_classes {::oo::class ::oo::object} } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 899 900 901 902 903 904 905 906 907 908 909 910 911 912 | } } } } namespace eval ::clay::dialect { variable core_classes {::oo::class ::oo::object} } ::clay::dialect::create ::clay proc ::clay::dynamic_methods class { foreach command [info commands [namespace current]::dynamic_methods_*] { $command $class } } proc ::clay::dynamic_methods_class {thisclass} { |
︙ | ︙ | |||
1039 1040 1041 1042 1043 1044 1045 | proc ::clay::define::destructor rawbody { set body { # Run the destructor once and only once set self [self] my variable DestroyEvent if {$DestroyEvent} return set DestroyEvent 1 | < | 967 968 969 970 971 972 973 974 975 976 977 978 979 980 | proc ::clay::define::destructor rawbody { set body { # Run the destructor once and only once set self [self] my variable DestroyEvent if {$DestroyEvent} return set DestroyEvent 1 } append body $rawbody ::oo::define [current_class] destructor $body } proc ::clay::define::Dict {name {values {}}} { set class [current_class] set name [string trim $name :/] |
︙ | ︙ | |||
1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 | variable $name [dict getnull $dictargs default] } } foreach {f v} $dictargs { $class clay set option $name $f $v } } proc ::clay::define::Option_Class {name args} { set class [current_class] set dictargs {default {}} set name [string trimleft $name -:] foreach {f v} [::clay::args_to_dict {*}$args] { $class clay set option_class $name [string trim $f -/:] $v } } proc ::clay::define::Variable {name {default {}}} { set class [current_class] set name [string trimright $name :/] $class clay set variable/ $name $default } | > > > > > > > > > > > < < < < < < < < < < < < < < < < | | > > > | | | > > > | | | 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 | variable $name [dict getnull $dictargs default] } } foreach {f v} $dictargs { $class clay set option $name $f $v } } proc ::clay::define::Method {name argstyle argspec body} { set class [current_class] set result {} switch $argstyle { dictargs { append result "::dictargs::parse \{$argspec\} \$args" \; } } append result $body oo::define $class method $name [list [list args [list dictargs $argspec]]] $result } proc ::clay::define::Option_Class {name args} { set class [current_class] set dictargs {default {}} set name [string trimleft $name -:] foreach {f v} [::clay::args_to_dict {*}$args] { $class clay set option_class $name [string trim $f -/:] $v } } proc ::clay::define::Variable {name {default {}}} { set class [current_class] set name [string trimright $name :/] $class clay set variable/ $name $default } ::namespace eval ::clay::define { } proc ::clay::ensemble_methodbody {ensemble einfo} { set default standard set preamble {} set eswitch {} if {[dict exists $einfo default]} { set emethodinfo [dict get $einfo default] set argspec [dict getnull $emethodinfo argspec] set realbody [dict getnull $emethodinfo body] set argstyle [dict getnull $emethodinfo argstyle] if {$argstyle eq "dictargs"} { set body "\n ::dictargs::parse \{$argspec\} \$args" } elseif {[llength $argspec]==1 && [lindex $argspec 0] in {{} args arglist}} { set body {} } else { set body "\n ::clay::dynamic_arguments $ensemble \$method [list $argspec] {*}\$args" } append body "\n " [string trim $realbody] " \n" set default $body dict unset einfo default } foreach {msubmethod esubmethodinfo} [lsort -dictionary -stride 2 $einfo] { set submethod [string trim $msubmethod :/-] if {$submethod eq "_body"} continue if {$submethod eq "_preamble"} { set preamble [dict getnull $esubmethodinfo body] continue } set argspec [dict getnull $esubmethodinfo argspec] set realbody [dict getnull $esubmethodinfo body] set argstyle [dict getnull $esubmethodinfo argstyle] if {[string length [string trim $realbody]] eq {}} { dict set eswitch $submethod {} } else { if {$argstyle eq "dictargs"} { set body "\n ::dictargs::parse \{$argspec\} \$args" } elseif {[llength $argspec]==1 && [lindex $argspec 0] in {{} args arglist}} { set body {} } else { set body "\n ::clay::dynamic_arguments $ensemble \$method [list $argspec] {*}\$args" } append body "\n " [string trim $realbody] " \n" if {$submethod eq "default"} { set default $body } else { foreach alias [dict getnull $esubmethodinfo aliases] { dict set eswitch $alias - |
︙ | ︙ | |||
1171 1172 1173 1174 1175 1176 1177 | append mbody $preamble \n append mbody \n [list set methodlist $methodlist] append mbody \n "set code \[catch {switch -- \$method [list $eswitch]} result opts\]" append mbody \n {return -options $opts $result} return $mbody } | | > > > > > > > > | > > > | | > > > > > | | | 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 | append mbody $preamble \n append mbody \n [list set methodlist $methodlist] append mbody \n "set code \[catch {switch -- \$method [list $eswitch]} result opts\]" append mbody \n {return -options $opts $result} return $mbody } ::proc ::clay::define::Ensemble {rawmethod args} { if {[llength $args]==2} { lassign $args argspec body set argstyle tcl } elseif {[llength $args]==3} { lassign $args argstyle argspec body } else { error "Usage: Ensemble name ?argstyle? argspec body" } set class [current_class] #if {$::clay::trace>2} { # puts [list $class Ensemble $rawmethod $argspec $body] #} set mlist [split $rawmethod "::"] set ensemble [string trim [lindex $mlist 0] :/] set mensemble ${ensemble}/ if {[llength $mlist]==1 || [lindex $mlist 1] in "_body"} { set method _body ### # Simple method, needs no parsing, but we do need to record we have one ### if {$argstyle eq "dictargs"} { set argspec [list args $argspec] } $class clay set method_ensemble/ $mensemble _body [dict create argspec $argspec body $body argstyle $argstyle] if {$::clay::trace>2} { puts [list $class clay set method_ensemble/ $mensemble _body ...] } set method $rawmethod if {$::clay::trace>2} { puts [list $class Ensemble $rawmethod $argspec $body] set rawbody $body set body {puts [list [self] $class [self method]]} append body \n $rawbody } if {$argstyle eq "dictargs"} { set rawbody $body set body "::dictargs::parse \{$argspec\} \$args\; " append body $rawbody } ::oo::define $class method $rawmethod $argspec $body return } set method [join [lrange $mlist 2 end] "::"] $class clay set method_ensemble/ $mensemble [string trim [lindex $method 0] :/] [dict create argspec $argspec body $body argstyle $argstyle] if {$::clay::trace>2} { puts [list $class clay set method_ensemble/ $mensemble [string trim $method :/] ...] } } ::oo::define ::clay::class { method clay {submethod args} { my variable clay |
︙ | ︙ | |||
1347 1348 1349 1350 1351 1352 1353 | ::oo::define ::clay::object { 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} { | > > > > > > > > > | > > > > > | 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 | ::oo::define ::clay::object { 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 {} if {[dict exists $clay cascade]} { dict for {f v} [dict get $clay cascade] { if {$f eq "."} continue if {[info commands $v] ne {}} { lappend clayorder $v } } } lappend clayorder {*}[::clay::ancestors [info object class [self]] {*}[lreverse [info object mixins [self]]]] } switch $submethod { ancestors { return $clayorder } branch { set path [::clay::tree::storage $args] if {![dict exists $clay {*}$path .]} { dict set clay {*}$path . {} } } cache { set path [lindex $args 0] set value [lindex $args 1] dict set claycache $path $value } cget { # Leaf searches return one data field at a time # Search in our local dict if {[llength $args]==1} { set field [string trim [lindex $args 0] -:/] if {[info exists option_canonical($field)]} { set field $option_canonical($field) |
︙ | ︙ | |||
1443 1444 1445 1446 1447 1448 1449 | ::clay::tree::dictmerge result [$class clay dump] } ::clay::tree::dictmerge result $clay return $result } ensemble_map { set ensemble [lindex $args 0] | < | 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 | ::clay::tree::dictmerge result [$class clay dump] } ::clay::tree::dictmerge result $clay return $result } ensemble_map { set ensemble [lindex $args 0] set mensemble [string trim $ensemble :/] if {[dict exists $claycache method_ensemble $mensemble]} { return [clay::tree::sanitize [dict get $claycache method_ensemble $mensemble]] } set emap [my clay dget method_ensemble $mensemble] dict set claycache method_ensemble $mensemble $emap return [clay::tree::sanitize $emap] |
︙ | ︙ | |||
1522 1523 1524 1525 1526 1527 1528 | # Search in the in our list of classes for an answer foreach class $clayorder { ::clay::tree::dictmerge result [$class clay dump] } ::clay::tree::dictmerge result $clay return $result } | < < < < < < < > > > > > | | < < < < < < < > > > > > > > > | | | > | > > | < < | > | 1479 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 | # Search in the in our list of classes for an answer foreach class $clayorder { ::clay::tree::dictmerge result [$class clay dump] } ::clay::tree::dictmerge result $clay return $result } if {[dict exists $clay {*}$path] && ![dict exists $clay {*}$path .]} { # Path is a leaf return [dict get $clay {*}$path] } # Search in our local cache if {[my clay search $path value isleaf]} { return $value } 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] my clay cache $path $result return $result } } # Path is a branch set result [dict getnull $clay {*}$path] foreach class $clayorder { if {![$class clay exists {*}$path .]} continue ::clay::tree::dictmerge result [$class clay dget {*}$path] } #if {[dict exists $clay {*}$path .]} { # ::clay::tree::dictmerge result #} my clay cache $path $result return $result } getnull - get { set path [::clay::tree::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 { ::clay::tree::dictmerge result [$class clay dump] } ::clay::tree::dictmerge result $clay return [::clay::tree::sanitize $result] } if {[dict exists $clay {*}$path] && ![dict exists $clay {*}$path .]} { # Path is a leaf return [dict get $clay {*}$path] } # Search in our local cache if {[my clay search $path value isleaf]} { if {!$isleaf} { return [clay::tree::sanitize $value] } else { return $value } } 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] my clay cache $path $result return $result } } # Path is a branch set result [dict getnull $clay {*}$path] #foreach class [lreverse $clayorder] { # if {![$class clay exists {*}$path .]} continue # ::clay::tree::dictmerge result [$class clay dget {*}$path] #} foreach class $clayorder { if {![$class clay exists {*}$path .]} continue ::clay::tree::dictmerge result [$class clay dget {*}$path] } #if {[dict exists $clay {*}$path .]} { # ::clay::tree::dictmerge result [dict get $clay {*}$path] #} my clay cache $path $result return [clay::tree::sanitize $result] } leaf { # Leaf searches return one data field at a time # Search in our local dict set path [::clay::tree::storage $args] if {[dict exists $clay {*}$path .]} { return [clay::tree::sanitize [dict get $clay {*}$path]] } if {[dict exists $clay {*}$path]} { return [dict get $clay {*}$path] } # Search in our local cache if {[my clay search $path value isleaf]} { if {!$isleaf} { return [clay::tree::sanitize $value] } else { return $value } } # Search in the in our list of classes for an answer foreach class $clayorder { if {[$class clay exists {*}$path]} { set value [$class clay get {*}$path] my clay cache $path $value return $value } } } merge { foreach arg $args { ::clay::tree::dictmerge clay {*}$arg } } mixin { ### # Mix in the class ### my clay flush set prior [info object mixins [self]] set newmixin {} foreach item $args { lappend newmixin ::[string trimleft $item :] } set newmap $args foreach class $prior { |
︙ | ︙ | |||
1689 1690 1691 1692 1693 1694 1695 | puts stderr "[self] MIXIN ERROR PEEKING $class:\n[dict get $errdat -errorinfo]" } break } } } mixinmap { | < | 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 | puts stderr "[self] MIXIN ERROR PEEKING $class:\n[dict get $errdat -errorinfo]" } break } } } mixinmap { if {![dict exists $clay .mixin]} { 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]] |
︙ | ︙ | |||
1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 | } 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] | > > > > > > > > > > > > > > > > > > > > > > > > > > > > < | 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 | } foreach class $clayorder { if {[$class clay exists {*}$args]} { return $class } } return {} } refcount { my variable refcount if {![info exists refcount]} { return 0 } return $refcount } refcount_incr { my variable refcount incr refcount } refcount_decr { my variable refcount incr refcount -1 if {$refcount <= 0} { ::clay::object_destroy [self] } } replace { set clay [lindex $args 0] } search { set path [lindex $args 0] upvar 1 [lindex $args 1] value [lindex $args 2] isleaf set isleaf [expr {![dict exists $claycache $path .]}] if {[dict exists $claycache $path]} { set value [dict get $claycache $path] return 1 } return 0 } source { source [lindex $args 0] } set { #puts [list [self] clay SET {*}$args] ::clay::tree::dictset clay {*}$args } default { dict $submethod clay {*}$args } } } |
︙ | ︙ | |||
1804 1805 1806 1807 1808 1809 1810 | } dict set config $field $value set setcmd [dict getnull $info set-command] if {$setcmd ne {}} { {*}[string map [list %field% [list $field] %value% [list $value] %self% [namespace which my]] $setcmd] } } | < | 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 | } dict set config $field $value set setcmd [dict getnull $info set-command] if {$setcmd ne {}} { {*}[string map [list %field% [list $field] %value% [list $value] %self% [namespace which my]] $setcmd] } } if {[info exists clay]} { set emap [dict getnull $clay method_ensemble] } else { set emap {} } foreach class [lreverse $clayorder] { ### |
︙ | ︙ | |||
1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 | } } ::clay::object clay branch array ::clay::object clay branch mixin ::clay::object clay branch option ::clay::object clay branch dict clay ::clay::object clay set variable DestroyEvent 0 namespace eval ::clay { namespace export * } ### # END: clay/clay.tcl ### | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 | } } ::clay::object clay branch array ::clay::object clay branch mixin ::clay::object clay branch option ::clay::object clay branch dict clay ::clay::object clay set variable DestroyEvent 0 if {[info commands ::cron::object_destroy] eq {}} { # Provide a noop if we aren't running with the cron scheduler namespace eval ::cron {} proc ::cron::object_destroy args {} } ::namespace eval ::clay::event { } proc ::clay::cleanup {} { set count 0 if {![info exists ::clay::idle_destroy]} return set objlist $::clay::idle_destroy set ::clay::idle_destroy {} foreach obj $objlist { if {![catch {$obj destroy}]} { incr count } } return $count } proc ::clay::object_create {objname {class {}}} { #if {$::clay::trace>0} { # puts [list $objname CREATE] #} } proc ::clay::object_rename {object newname} { if {$::clay::trace>0} { puts [list $object RENAME -> $newname] } } proc ::clay::object_destroy args { if {![info exists ::clay::idle_destroy]} { set ::clay::idle_destroy {} } foreach objname $args { if {$::clay::trace>0} { puts [list $objname DESTROY] } ::cron::object_destroy $objname if {$objname in $::clay::idle_destroy} continue lappend ::clay::idle_destroy $objname } } proc ::clay::event::cancel {self {task *}} { variable timer_event variable timer_script foreach {id event} [array get timer_event $self:$task] { ::after cancel $event set timer_event($id) {} set timer_script($id) {} } } proc ::clay::event::generate {self event args} { set wholist [Notification_list $self $event] if {$wholist eq {}} return set dictargs [::oo::meta::args_to_options {*}$args] set info $dictargs set strict 0 set debug 0 set sender $self dict with dictargs {} dict set info id [::clay::event::nextid] dict set info origin $self dict set info sender $sender dict set info rcpt {} foreach who $wholist { catch {::clay::event::notify $who $self $event $info} } } proc ::clay::event::nextid {} { return "event#[format %0.8x [incr ::clay::event_count]]" } proc ::clay::event::Notification_list {self event {stackvar {}}} { set notify_list {} foreach {obj patternlist} [array get ::clay::object_subscribe] { if {$obj eq $self} continue if {$obj in $notify_list} continue set match 0 foreach {objpat eventlist} $patternlist { if {![string match $objpat $self]} continue foreach eventpat $eventlist { if {![string match $eventpat $event]} continue set match 1 break } if {$match} { break } } if {$match} { lappend notify_list $obj } } return $notify_list } proc ::clay::event::notify {rcpt sender event eventinfo} { if {[info commands $rcpt] eq {}} return if {$::clay::trace} { puts [list event notify rcpt $rcpt sender $sender event $event info $eventinfo] } $rcpt notify $event $sender $eventinfo } proc ::clay::event::process {self handle script} { variable timer_event variable timer_script array unset timer_event $self:$handle array unset timer_script $self:$handle set err [catch {uplevel #0 $script} result errdat] if $err { puts "BGError: $self $handle $script ERR: $result [dict get $errdat -errorinfo] ***" } } proc ::clay::event::schedule {self handle interval script} { variable timer_event variable timer_script if {$::clay::trace} { puts [list $self schedule $handle $interval] } if {[info exists timer_event($self:$handle)]} { if {$script eq $timer_script($self:$handle)} { return } ::after cancel $timer_event($self:$handle) } set timer_script($self:$handle) $script set timer_event($self:$handle) [::after $interval [list ::clay::event::process $self $handle $script]] } proc ::clay::event::subscribe {self who event} { upvar #0 ::clay::object_subscribe($self) subscriptions if {![info exists subscriptions]} { set subscriptions {} } set match 0 foreach {objpat eventlist} $subscriptions { if {![string match $objpat $who]} continue foreach eventpat $eventlist { if {[string match $eventpat $event]} { # This rule already exists return } } } dict lappend subscriptions $who $event } proc ::clay::event::unsubscribe {self args} { upvar #0 ::clay::object_subscribe($self) subscriptions if {![info exists subscriptions]} { return } switch [llength $args] { 1 { set event [lindex $args 0] if {$event eq "*"} { # Shortcut, if the set subscriptions {} } else { set newlist {} foreach {objpat eventlist} $subscriptions { foreach eventpat $eventlist { if {[string match $event $eventpat]} continue dict lappend newlist $objpat $eventpat } } set subscriptions $newlist } } 2 { set who [lindex $args 0] set event [lindex $args 1] if {$who eq "*" && $event eq "*"} { set subscriptions {} } else { set newlist {} foreach {objpat eventlist} $subscriptions { if {[string match $who $objpat]} { foreach eventpat $eventlist { if {[string match $event $eventpat]} continue dict lappend newlist $objpat $eventpat } } } set subscriptions $newlist } } } } namespace eval ::clay { namespace export * } ### # END: clay/clay.tcl ### |
︙ | ︙ | |||
1937 1938 1939 1940 1941 1942 1943 | } } } ::oo::class create ::practcl::doctool { constructor {} { my reset } | | | | 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 | } } } ::oo::class create ::practcl::doctool { constructor {} { my reset } method argspec {argspec} { set result [dict create] foreach arg $argspec { set name [lindex $arg 0] dict set result $name positional 1 dict set result $name mandatory 1 if {$name in {args dictargs}} { switch [llength $arg] { 1 { dict set result $name mandatory 0 |
︙ | ︙ | |||
1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 | } else { set firstword [string range $sline 0 [expr {$fwidx-1}]] set restline [string range $sline [expr {$fwidx+1}] end] } if {[string index $firstword end] eq ":"} { set field [string tolower [string trim $firstword -:]] switch $field { desc { set field description } } if {[string length $restline]} { dict append result $field "$restline\n" } | > > > > | 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 | } else { set firstword [string range $sline 0 [expr {$fwidx-1}]] set restline [string range $sline [expr {$fwidx+1}] end] } if {[string index $firstword end] eq ":"} { set field [string tolower [string trim $firstword -:]] switch $field { dictargs - arglist { set field argspec } desc { set field description } } if {[string length $restline]} { dict append result $field "$restline\n" } |
︙ | ︙ | |||
2154 2155 2156 2157 2158 2159 2160 | if {[dict exists $info ensemble]} { dict for {method minfo} [dict get $info ensemble] { dict set result Class_Method "${name} $method" $minfo } } else { switch [llength $args] { 1 { | | | | | | | | | | | | | 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 | if {[dict exists $info ensemble]} { dict for {method minfo} [dict get $info ensemble] { dict set result Class_Method "${name} $method" $minfo } } else { switch [llength $args] { 1 { set argspec [lindex $args 0] } 0 { set argspec dictargs #set body [lindex $args 0] } default {error "could not interpret method $name {*}$args"} } if {![dict exists $info argspec]} { dict set info argspec [my argspec $argspec] } dict set result Class_Method [string trim $name :] $info } } method keyword.method {resultvar commentblock name args} { upvar 1 $resultvar result set info [my comment $commentblock] if {[dict exists $info show_body] && [dict get $info show_body]} { dict set info internals [lindex $args end] } if {[dict exists $info ensemble]} { dict for {method minfo} [dict get $info ensemble] { dict set result method "\"${name} $method\"" $minfo } } else { switch [llength $args] { 1 { set argspec [lindex $args 0] } 0 { set argspec dictargs #set body [lindex $args 0] } default {error "could not interpret method $name {*}$args"} } if {![dict exists $info argspec]} { dict set info argspec [my argspec $argspec] } dict set result method "\"[split [string trim $name :] ::]\"" $info } } method keyword.proc {commentblock name argspec} { set info [my comment $commentblock] if {![dict exists $info argspec]} { dict set info argspec [my argspec $argspec] } return $info } method reset {} { my variable coro set coro [info object namespace [self]]::coro oo::objdefine [self] forward coro $coro |
︙ | ︙ | |||
2293 2294 2295 2296 2297 2298 2299 | } set thisline {} } } method section.method {keyword method minfo} { set result {} set line "\[call $keyword \[cmd $method\]" | | | | 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 | } set thisline {} } } method section.method {keyword method minfo} { set result {} set line "\[call $keyword \[cmd $method\]" if {[dict exists $minfo argspec]} { dict for {argname arginfo} [dict get $minfo argspec] { set positional 1 set mandatory 1 set repeating 0 dict with arginfo {} if {$mandatory==0} { append line " \[opt \"" } else { |
︙ | ︙ | |||
3992 3993 3994 3995 3996 3997 3998 | method Autoconf {} { ### # Re-run autoconf for this project # Not a good idea in practice... but in the right hands it can be useful ### set pwd [pwd] set srcdir [file normalize [my define get srcdir]] | > | | 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 | method Autoconf {} { ### # Re-run autoconf for this project # Not a good idea in practice... but in the right hands it can be useful ### set pwd [pwd] set srcdir [file normalize [my define get srcdir]] set localsrcdir [my MakeDir $srcdir] cd $localsrcdir foreach template {configure.ac configure.in} { set input [file join $srcdir $template] if {[file exists $input]} { puts "autoconf -f $input > [file join $srcdir configure]" exec autoconf -f $input > [file join $srcdir configure] } } |
︙ | ︙ | |||
4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 | windows { if {[file exists [file join $srcdir win]]} { my define add include_dir [file join $srcdir win] } if {[file exists [file join $srcdir win Makefile.in]]} { set localsrcdir [file join $srcdir win] } } default { if {[file exists [file join $srcdir $os]]} { my define add include_dir [file join $srcdir $os] } if {[file exists [file join $srcdir unix]]} { my define add include_dir [file join $srcdir unix] } if {[file exists [file join $srcdir $os Makefile.in]]} { set localsrcdir [file join $srcdir $os] } elseif {[file exists [file join $srcdir unix Makefile.in]]} { set localsrcdir [file join $srcdir unix] } } } return $localsrcdir } Ensemble make::autodetect {} { set srcdir [my define get srcdir] | > > > > > | | 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 | windows { if {[file exists [file join $srcdir win]]} { my define add include_dir [file join $srcdir win] } if {[file exists [file join $srcdir win Makefile.in]]} { set localsrcdir [file join $srcdir win] } } macosx { if {[file exists [file join $srcdir unix Makefile.in]]} { set localsrcdir [file join $srcdir unix] } } default { if {[file exists [file join $srcdir $os]]} { my define add include_dir [file join $srcdir $os] } if {[file exists [file join $srcdir unix]]} { my define add include_dir [file join $srcdir unix] } if {[file exists [file join $srcdir $os Makefile.in]]} { set localsrcdir [file join $srcdir $os] } elseif {[file exists [file join $srcdir unix Makefile.in]]} { set localsrcdir [file join $srcdir unix] } } } return $localsrcdir } Ensemble make::autodetect {} { set srcdir [my define get srcdir] set localsrcdir [my MakeDir $srcdir] if {$localsrcdir eq {}} { set localsrcdir $srcdir } if {$srcdir eq $localsrcdir} { if {![file exists [file join $srcdir tclconfig install-sh]]} { # ensure we have tclconfig with all of the trimmings set teapath {} |
︙ | ︙ | |||
4514 4515 4516 4517 4518 4519 4520 | exec {*}$cmd >&@ stdout } set ranlib [$PROJECT define get RANLIB] if {$ranlib ni {{} :}} { catch {exec $ranlib $outfile} } } | | | 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 | exec {*}$cmd >&@ stdout } set ranlib [$PROJECT define get RANLIB] if {$ranlib ni {{} :}} { catch {exec $ranlib $outfile} } } method build-tclsh {outfile PROJECT {path {auto}}} { if {[my define get tk 0] && [my define get static_tk 0]} { puts " BUILDING STATIC TCL/TK EXE $PROJECT" set TKOBJ [$PROJECT tkcore] if {[info command $TKOBJ] eq {}} { set TKOBJ ::noop $PROJECT define set static_tk 0 } else { |
︙ | ︙ | |||
4548 4549 4550 4551 4552 4553 4554 | } foreach item [$PROJECT link list package] { if {[string is true [$item define get static]]} { lappend PKG_OBJS $item } } array set TCL [$TCLOBJ read_configuration] | > | > > > > | 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 | } foreach item [$PROJECT link list package] { if {[string is true [$item define get static]]} { lappend PKG_OBJS $item } } array set TCL [$TCLOBJ read_configuration] if {$path in {{} auto}} { set path [file dirname [file normalize $outfile]] } if {$path eq "."} { set path [pwd] } cd $path ### # For a static Tcl shell, we need to build all local sources # with the same DEFS flags as the tcl core was compiled with. # The DEFS produced by a TEA extension aren't intended to operate # with the internals of a staticly linked Tcl ### |
︙ | ︙ | |||
7079 7080 7081 7082 7083 7084 7085 | set map {} foreach var { vfsroot mainhook mainfunc vfs_main } { dict set map %${var}% [set $var] } | | < > > > > > > > > > > > > > > > > > > > > > > > > > > | 7268 7269 7270 7271 7272 7273 7274 7275 7276 7277 7278 7279 7280 7281 7282 7283 7284 7285 7286 7287 7288 7289 7290 7291 7292 7293 7294 7295 7296 7297 7298 7299 7300 7301 7302 7303 7304 7305 7306 7307 7308 7309 7310 7311 7312 7313 7314 7315 7316 7317 7318 7319 7320 7321 7322 | set map {} foreach var { vfsroot mainhook mainfunc vfs_main } { dict set map %${var}% [set $var] } set preinitscript { set ::odie(boot_vfs) %vfsroot% set ::SRCDIR $::odie(boot_vfs) namespace eval ::starkit {} set ::starkit::topdir %vfsroot% if {[file exists [file join %vfsroot% tcl_library init.tcl]]} { set ::tcl_library [file join %vfsroot% tcl_library] set ::auto_path {} } if {[file exists [file join %vfsroot% tk_library tk.tcl]]} { set ::tk_library [file join %vfsroot% tk_library] } } ; # Preinitscript set main_init_script {} set thread_init_script {} append preinitscript \n {namespace eval ::starkit {}} append preinitscript \n [list set ::starkit::topdir $vfsroot] foreach {statpkg info} $statpkglist { set script [list package ifneeded $statpkg [dict get $info version] [list ::load {} $statpkg]] append preinitscript \n $script if {[dict get $info autoload]} { append main_init_script \n [list ::load {} $statpkg] } } append main_init_script \n { # Specify a user-specific startup file to invoke if the application # is run interactively. Typically the startup file is "~/.apprc" # where "app" is the name of the application. If this line is deleted # then no user-specific startup file will be run under any conditions. } append main_init_script \n {if {[file exists [file join $::starkit::topdir pkgIndex.tcl]]} { #In a wrapped exe, we don't go out to the environment set dir $::starkit::topdir source [file join $::starkit::topdir pkgIndex.tcl] }} append main_init_script \n [list set tcl_rcFileName [$PROJECT define get tcl_rcFileName ~/.tclshrc]] append preinitscript \n [list set ::starkit::thread_init $thread_init_script] append preinitscript \n {eval $::starkit::thread_init} set zvfsboot { /* * %mainhook% -- * Performs the argument munging for the shell */ } ::practcl::cputs zvfsboot { |
︙ | ︙ | |||
7181 7182 7183 7184 7185 7186 7187 | return TCL_ERROR; } } if {![$PROJECT define get tip_430 0]} { ::practcl::cputs appinit { TclZipfs_Init(interp);} } | < < < < < < < < < < < < < < < < < < | < < < < < | | 7395 7396 7397 7398 7399 7400 7401 7402 7403 7404 7405 7406 7407 7408 7409 7410 7411 7412 7413 7414 7415 7416 7417 7418 7419 7420 7421 7422 7423 7424 7425 7426 7427 7428 7429 7430 7431 | return TCL_ERROR; } } if {![$PROJECT define get tip_430 0]} { ::practcl::cputs appinit { TclZipfs_Init(interp);} } foreach {statpkg info} $statpkglist { set initfunc {} if {[dict exists $info initfunc]} { set initfunc [dict get $info initfunc] } if {$initfunc eq {}} { set initfunc [string totitle ${statpkg}]_Init } if {![dict exists $info version]} { error "$statpkg HAS NO VERSION" } # We employ a NULL to prevent the package system from thinking the # package is actually loaded into the interpreter $PROJECT code header "extern Tcl_PackageInitProc $initfunc\;\n" if {[dict get $info autoload]} { ::practcl::cputs appinit " if(${initfunc}(interp)) return TCL_ERROR\;" ::practcl::cputs appinit " Tcl_StaticPackage(interp,\"$statpkg\",$initfunc,NULL)\;" } else { ::practcl::cputs appinit "\n Tcl_StaticPackage(NULL,\"$statpkg\",$initfunc,NULL)\;" } } practcl::cputs appinit " Tcl_Eval(interp,[::practcl::tcl_to_c $main_init_script]);" practcl::cputs appinit { return TCL_OK;} $PROJECT c_function [string map $map "int %mainfunc%(Tcl_Interp *interp)"] [string map $map $appinit] } method Collate_Source CWD { next $CWD set name [my define get name] # Assume a static shell |
︙ | ︙ | |||
7268 7269 7270 7271 7272 7273 7274 | if {[string is true [$item define get static]]} { lappend PKG_OBJS $item } } # Arrange to build an main.c that utilizes TCL_LOCAL_APPINIT and TCL_LOCAL_MAIN_HOOK if {$os eq "windows"} { set PLATFORM_SRC_DIR win | | | | 7459 7460 7461 7462 7463 7464 7465 7466 7467 7468 7469 7470 7471 7472 7473 7474 7475 7476 7477 7478 7479 7480 7481 7482 7483 | if {[string is true [$item define get static]]} { lappend PKG_OBJS $item } } # Arrange to build an main.c that utilizes TCL_LOCAL_APPINIT and TCL_LOCAL_MAIN_HOOK if {$os eq "windows"} { set PLATFORM_SRC_DIR win if {![my define get SHARED_BUILD 0]} { my add class csource filename [file join $TCLSRCDIR win tclWinReg.c] initfunc Registry_Init pkg_name registry pkg_vers 1.3.1 autoload 1 my add class csource filename [file join $TCLSRCDIR win tclWinDde.c] initfunc Dde_Init pkg_name dde pkg_vers 1.4.0 autoload 1 } my add class csource ofile [my define get name]_appinit.o filename [file join $TCLSRCDIR win tclAppInit.c] extra [list -DTCL_LOCAL_MAIN_HOOK=[my define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] -DTCL_LOCAL_APPINIT=[my define get TCL_LOCAL_APPINIT Tclkit_AppInit]] } else { set PLATFORM_SRC_DIR unix my add class csource ofile [my define get name]_appinit.o filename [file join $TCLSRCDIR unix tclAppInit.c] extra [list -DTCL_LOCAL_MAIN_HOOK=[my define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] -DTCL_LOCAL_APPINIT=[my define get TCL_LOCAL_APPINIT Tclkit_AppInit]] } if {![my define get SHARED_BUILD 0]} { ### # Add local static Zlib implementation ### set cdir [file join $TCLSRCDIR compat zlib] foreach file { adler32.c compress.c crc32.c deflate.c infback.c inffast.c |
︙ | ︙ | |||
7308 7309 7310 7311 7312 7313 7314 | if {[file exists $zipfs]} { $TCLOBJ define set tip_430 1 my define set tip_430 1 } else { # The Tclconfig project maintains a mirror of the version # released with the Tcl core my define set tip_430 0 | > > | | > > > | | 7499 7500 7501 7502 7503 7504 7505 7506 7507 7508 7509 7510 7511 7512 7513 7514 7515 7516 7517 7518 7519 7520 | if {[file exists $zipfs]} { $TCLOBJ define set tip_430 1 my define set tip_430 1 } else { # The Tclconfig project maintains a mirror of the version # released with the Tcl core my define set tip_430 0 set tclzipfs_c [my define get tclzipfs_c] if {![file exists $tclzipfs_c]} { ::practcl::LOCAL tool tclconfig unpack set COMPATSRCROOT [::practcl::LOCAL tool tclconfig define get srcdir] set tclzipfs_c [file join $COMPATSRCROOT compat tclZipfs.c] } my add class csource ofile tclZipfs.o filename $tclzipfs_c \ extra -I[::practcl::file_relative $CWD [file join $TCLSRCDIR compat zlib contrib minizip]] } my define add include_dir [file join $TCLSRCDIR generic] my define add include_dir [file join $TCLSRCDIR $PLATFORM_SRC_DIR] # This file will implement TCL_LOCAL_APPINIT and TCL_LOCAL_MAIN_HOOK my build-tclkit_main $PROJECT $PKG_OBJS } |
︙ | ︙ | |||
7357 7358 7359 7360 7361 7362 7363 | lappend ::auto_path $::tcl_teapot } puts $fout [list proc installDir [info args ::practcl::installDir] [info body ::practcl::installDir]] set buffer [::practcl::pkgindex_path $vfspath] puts $fout $buffer puts $fout { # Advertise statically linked packages | | | 7553 7554 7555 7556 7557 7558 7559 7560 7561 7562 7563 7564 7565 7566 7567 | lappend ::auto_path $::tcl_teapot } puts $fout [list proc installDir [info args ::practcl::installDir] [info body ::practcl::installDir]] set buffer [::practcl::pkgindex_path $vfspath] puts $fout $buffer puts $fout { # Advertise statically linked packages foreach {pkg script} [array get ::starkit::static_packages] { eval $script } } puts $fout { ### # Cache binary packages distributed as dynamic libraries in a known location ### |
︙ | ︙ |