Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Difference From 5eb576fc2d423f1d
To 42e1f63ae401c9ea
2019-06-29
| | |
11:21 |
|
check-in: 8c1eac0227 user: hypnotoad tags: trunk
|
2019-06-27
| | |
19:02 |
|
check-in: 1ae1cac113 user: hypnotoad tags: yggdrasil
|
09:56 |
|
check-in: 42e1f63ae4 user: hypnotoad tags: yggdrasil
|
09:30 |
|
check-in: 6d7b608d54 user: hypnotoad tags: yggdrasil
|
2019-06-26
| | |
21:13 |
|
check-in: 5eb576fc2d user: hypnotoad tags: trunk
|
20:22 |
|
check-in: e41d5380a9 user: hypnotoad tags: trunk
|
| | |
Changes to cmodules/kitcrypt.tcl.
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
|
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
|
-
-
-
-
-
-
+
+
+
+
+
+
-
+
|
##
# Implementation of an rc4 codec for TCL, adapted for
# source code encryption/decryption system
###
set here [file dirname [info script]]
my define set pkg_name kitcrypt
my define set pkg_vers 1.0
my define set initfunc KitCrypt_Init
my define set output_c kitcrypt.c
my define set autoload 1
my define set static 1
my Config_set pkg_name kitcrypt
my Config_set pkg_vers 1.0
my Config_set initfunc KitCrypt_Init
my Config_set output_c kitcrypt.c
my Config_set autoload 1
my Config_set static 1
my include {<stdio.h>}
my include {<string.h>}
my include {<stdlib.h>}
my include {<tcl.h>}
# Retrieve or generate a hard coded password for the crypt_eval function
# We write the code here so that a DLL and an EXE built from the same source
# checkout will have the same internal password
set pwdfile [file join [my define get builddir] password.txt]
set pwdfile [file join [my Config_get builddir] password.txt]
if {![file exists $pwdfile]} {
set charset {*+-.0123456789@ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_}
set maxpos [string length $charset]
set keylen [expr 8 + int(8 * rand())]
set curpwd {}
for {set idx 0} {$idx < $keylen} {incr idx} {
append curpwd [string index $charset [expr int($maxpos * rand())]]
|
︙ | | |
Changes to example/gilgamesh/class/avatar.tcl.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
-
+
-
+
|
::clay::define ::gilgamesh::html {
superclass ::cuneiform::html ::cuneiform::element
constructor {} {
my variable html css
set html {}
set css {}
my cuneiform_structure
}
method cuneiform_structure {} {
my clay delegate <head> [my Tag head]
my clay delegate <title> [my <head> tag title]
my <head> tag meta charset [my html get charset]
my <head> tag meta charset [my config get charset]
my clay delegate <stylesheet> [my <head> tag link rel stylesheet type text/css href /style.css]
set sheethref [my html get stylesheet]
set sheethref [my config get stylesheet]
if {$sheethref ne {}} {
my <stylesheet> html set href $sheethref
}
set styleobj [my <head> tag style]
my clay delegate <style> $styleobj
my clay delegate <style:screen> $styleobj
|
︙ | | |
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
-
+
|
width 1000px
overflow-y auto
height 600px
}]
my clay delegate <bottom> [$bodyobj tag div id bottom]
my clay delegate <footer> [$bodyobj tag footer id footer]
my <title> content [my html get title]
my <title> content [my config get title]
}
}
::clay::define ::gilgamesh::core/avatar {
superclass ::gilgamesh::core/actor
|
︙ | | |
Changes to make.tcl.
︙ | | |
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
-
+
|
source [file join $::main::DIR scripts practcl.tcl]
set ::SRCDIR $::main::DIR
::practcl::library create PROJECT {
name clay
version 0.1
}
[::practcl::LOCAL tool tcllib] define set tag hypnotoad
[::practcl::LOCAL tool tcllib] config set tag hypnotoad
::practcl::LOCAL add_tool clay {
tag trunk
class subproject.sak
install vfs
fossil_url http://fossil.etoyoc.com/clay
}
::practcl::LOCAL add_tool thread {
|
︙ | | |
136
137
138
139
140
141
142
143
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
204
|
136
137
138
139
140
141
142
143
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
204
|
-
+
-
-
-
+
+
+
-
-
+
+
-
-
+
+
-
+
-
+
-
-
+
+
-
-
+
+
-
+
-
-
+
+
-
+
|
cmdline csv coroutine cron devtools dns
sha1 uri
}
} {
set obj [::practcl::LOCAL tool $project]
$obj unpack
$obj update
set lsrcdir [$obj define get srcdir]
set lsrcdir [$obj config get srcdir]
foreach module $modules {
installModule [file join $lsrcdir modules $module] $DEST
}
}
}
claykit {
set dat [::practcl::config.tcl $CWD]
set object TCLKIT
::practcl::tclkit create $object $dat
$object define set name claykit
$object define set sandbox $::SANDBOX
$object define set srcdir $::SRCDIR
$object config set name claykit
$object config set sandbox $::SANDBOX
$object config set srcdir $::SRCDIR
$object source [file join $::SRCDIR claykit.ini]
set INSTALLDIR [$object define get installdir]
if {![file exists [$object define get tclkit_bare]]} {
set INSTALLDIR [$object config get installdir]
if {![file exists [$object config get tclkit_bare]]} {
$object build-tclcore
$object implement $CWD
foreach item [$object link list package] {
if {![string is true [$item define get static 0]]} continue
puts [list GENERATING $item [$item define get srcdir]]
if {![string is true [$item config get static 0]]} continue
puts [list GENERATING $item [$item config get srcdir]]
$item compile
}
$object build-tclsh [$object define get tclkit_bare] $object
$object build-tclsh [$object config get tclkit_bare] $object
}
set VFS [file join $CWD [$object define get vfs]]
set VFS [file join $CWD [$object config get vfs]]
file mkdir $VFS
foreach item [$object link list package] {
set modlist [$item define get module_list]
puts [list PACKAGE INSTALL [$item define get name] MODLIST $modlist]
set modlist [$item config get module_list]
puts [list PACKAGE INSTALL [$item config get name] MODLIST $modlist]
if {[llength $modlist]} {
if {[catch {$item install-module [file join ${VFS} modules] {*}$modlist} error errdat]} {
puts stderr "BUILD FAILURE $item"
puts "FAILED TO INSTALL package $item"
puts [dict get $errdat -errorinfo]
exit 1
}
} elseif {[string is true [$item define get vfsinstall 1]]} {
puts [list GENERATING $item [$item define get srcdir]]
} elseif {[string is true [$item config get vfsinstall 1]]} {
puts [list GENERATING $item [$item config get srcdir]]
if {[catch {$item install $INSTALLDIR} error errdat]} {
puts stderr "BUILD FAILURE $item"
puts "FAILED TO INSTALL package $item"
puts [dict get $errdat -errorinfo]
exit 1
}
}
}
# Copy in our "secret squirrel" code
#set SCMCOPY [list ::exec [WISHKIT define get tclkit_bare] [file join $::SRCDIR scripts scm-copy.tcl]]
#set SCMCOPY [list ::exec [WISHKIT config get tclkit_bare] [file join $::SRCDIR scripts scm-copy.tcl]]
#set SCMCOPY ::practcl::copyDir
#{*}$SCMCOPY [file join $::SRCDIR src] ${VFS}
if {[$object define get debug 0]} {
$object wrap $CWD [$object define get exe] $VFS [file join $CWD PKGROOT]
if {[$object config get debug 0]} {
$object wrap $CWD [$object config get exe] $VFS [file join $CWD PKGROOT]
} else {
$object wrap $CWD [$object define get exe] $VFS [file join $CWD PKGROOT]
$object wrap $CWD [$object config get exe] $VFS [file join $CWD PKGROOT]
}
}
modules {
set modules [modules]
puts $modules
exit 0
#return $result
|
︙ | | |
Changes to modules/clay-tk-console/build/core.tcl.
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
|
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
|
-
+
-
+
-
+
|
package require clay-tk
###
# Implement a interactive command line for Tcl. This class
# contains the common plumbing for several languages.
###
namespace eval ::clay::tk::console {}
::clay::define ::clay::tk::hull.console {
Variable ismain 0
clay set option language {
Option language {
default tcl
class mixin
pattern ::clay::tk::console
}
clay set option title {
Option title {
default {}
}
clay set option prompt {
Option prompt {
default {tcl% }
}
set has_consolas [expr {"Consolas" in [font families]}]
if {$has_consolas} {
set font {Consolas 10}
switch $::clay::tk::platform {
macosx {
|
︙ | | |
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
-
+
|
set font {system 10}
}
windows {
set font {systemfixed 9}
}
}
}
clay set option font [list \
Option font [list \
widget font \
description {Font used on console widgets} \
default $font ]
clay set signal focus {
follows *
action {focus [my clay delegate text]}
|
︙ | | |
Changes to modules/clay-tk-console/build/sqlshell.tcl.
︙ | | |
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
-
-
-
-
-
+
+
+
+
+
|
}
}
###
# Implement an interactive command line interface to an Sqlite database
###
::clay::define ::clay::tk::console::language.sqlite {
clay set option db {class organ}
clay set option prompt {default {sqlite-> }}
clay set option title {default {SQLite Console}}
clay set option header {datatype boolean default 1}
clay set option mode {widget select default column values {line list column csv multicolumn}}
Option db {class organ}
Option prompt {default {sqlite-> }}
Option title {default {SQLite Console}}
Option header {datatype boolean default 1}
Option mode {widget select default column values {line list column csv multicolumn}}
###
# topic: 43e235cf3b612e95c590e5de400d4bcc39d622a4
# description:
# Execute a single SQL command. Pay special attention to control
# directives that begin with "."
|
︙ | | |
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
-
+
-
+
|
set header [my Config_get header]
if {[regexp {^(\.[a-z]+)} $cmd all word]} {
if {$word==".tcl"} {
my tcl_console
return {}
} elseif {$word==".mode"} {
regexp {^.[a-z]+ +([a-z]+)} $cmd all newvalue
my config set [list mode $newvalue]
my Config_set [list mode $newvalue]
return {}
} elseif {$word==".exit"} {
my destroy
return {}
} elseif {$word==".header"} {
regexp {^.[a-z]+ +([a-z]+)} $cmd all newvalue
my config set [list header $newvalue]
my Config_set [list header $newvalue]
return {}
} elseif {$word==".tables"} {
set mode multicolumn
set cmd {SELECT name FROM sqlite_master WHERE type='table'
UNION ALL
SELECT name FROM sqlite_temp_master WHERE type='table'}
my <db> eval {PRAGMA database_list} {
|
︙ | | |
Changes to modules/clay-tk/build/core.tcl.
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
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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
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
|
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
namespace eval ::clay::tk {}
package require clay-yggdrasil
set ::clay::tk::winsys [tk windowingsystem]
if {$::tcl_platform(platform) eq "windows"} {
set ::clay::tk::platform windows
catch {::ttk::style theme use xpnative}
} else {
if {$::tcl_platform(os) == "Darwin"} {
set ::clay::tk::platform macosx
} else {
set ::clay::tk::platform unix
}
catch {::ttk::style theme use clam}
}
::clay::define ::clay::tk::megawidget {
superclass ::clay::yggdrasil
constructor {tkpath args} {
my Config_initialize $args
my Config_merge $args
my Hull_Construct $tkpath
my content
}
destructor {
my Hull_Destroy
}
Ensemble config::get args {
return [my Config_get {*}$args]
}
Ensemble config::merge args {
return [my Config_merge {*}$args]
}
Ensemble config::set args {
my Config_set {*}$args
}
method Config_initialize args {
set mixinmap {}
dict for {opt optinfo} [my clay get option] {
if {[dict getnull $optinfo class] != "mixin"} continue
dict set mixinmap $opt [my MegaMixin $opt [dict get $optinfo default]]
}
if {[dict size $mixinmap]} {
my clay mixinmap {*}$mixinmap
}
}
method Config_get {field args} {
my variable config option_canonical option_getcmd
set field [string trimleft $field -]
if {[info exists option_canonical($field)]} {
set field $option_canonical($field)
}
if {[info exists option_getcmd($field)]} {
return [eval $option_getcmd($field)]
}
if {[dict exists $config $field]} {
return [dict get $config $field]
}
if {[llength $args]} {
return [lindex $args 0]
}
return [my clay get option $field default]
}
###
# topic: dc9fba12ec23a3ad000c66aea17135a5
###
method Config_merge dictargs {
my variable config option_canonical
set rawlist $dictargs
set dictargs {}
set mixinmap {}
foreach {field val} $rawlist {
set field [string trim $field -:/]
if {[info exists option_canonical($field)]} {
set field $option_canonical($field)
}
if {$field eq "mixinmap"} {
my clay mixinmap {*}$val
} elseif {$field eq "delegate"} {
my clay delegate {*}$val
} else {
dict set dictargs $field $val
}
}
foreach {field val} $dictargs {
if {[my clay get option $field class] eq "mixin"} {
my clay mixinmap $field [my MegaMixin $field $val]
}
}
#if {[dict size $mixinmap]} {
# my clay mixinmap {*}$mixinmap
#}
###
# Validate all inputs
###
foreach {field val} $dictargs {
set script [my clay get option $field validate-command]
if {$script ne {}} {
dict set dictargs $field [eval [string map [list %field% [list $field] %value% [list $val] %self% [namespace which my]] $script]]
}
}
###
# Apply all inputs with special rules
###
foreach {field val} $dictargs {
set script [my clay get option $field set-command]
dict set config $field $val
if {$script ne {}} {
{*}[string map [list %field% [list $field] %value% [list $val] %self% [namespace which my]] $script]
}
}
return $dictargs
}
method Config_set args {
set dictargs [::clay::args_to_options {*}$args]
set dat [my Config_merge $dictargs]
my Config_triggers $dat
}
###
# React to configuration changes
###
method Config_triggers dictargs {
foreach {field val} $dictargs {
set script [my clay get option $field post-command]
if {$script ne {}} {
{*}[string map [list %field% [list $field] %value% [list $val] %self% [namespace which my]] $script]
}
}
}
method content {} {}
method event {submethod args} {
::clay::event::$submethod [self] {*}$args
}
method Hull_Bind {} {
|
︙ | | |
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
211
212
213
214
215
216
217
218
|
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
method Hull_Unbind {} {
set tkpath [my clay delegate hull]
if {![winfo exists $tkpath]} return
bind $tkpath <Destroy> {}
}
method MegaMixin {field value} {
set pattern [my clay get option $field pattern]
set default [my clay get option $field default]
if {$value eq {}} {
return "${pattern}.${default}"
}
if {[string index $value 0] eq ":" && [info commands $value] ne {}} {
return $value
}
foreach trial {
{${pattern}.$value}
{${pattern}::$value}
{${pattern}::${field}.$value}
{${pattern}::${field}.${default}.$value}
{::clay::tk::${field}.$value}
{::clay::tk::$value}
} {
set str [subst $trial]
if {[info commands $str] ne {}} {
return $str
}
}
return "${pattern}.${default}"
}
method Option_Default field {
set info [my meta getnull option $field]
set getcmd [dict getnull $info default-command:]
if {$getcmd ne {}} {
return [{*}[string map [list %field% $field %self% [namespace which my]] $getcmd]]
} else {
return [dict getnull $info default:]
}
}
method signal args {}
# Renames the tcl command that represents the widget to
# one that resides in the object's namespace. It then renames
# the object to catch calls to the tk path.
###
method tkalias tkname {
|
︙ | | |
Changes to modules/clay-tk/build/hull.tcl.
︙ | | |
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
|
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
|
-
+
-
+
|
if {![winfo ismapped $h]} return
bind $h <Configure> {}
update idletasks
try {
set w [winfo parent $h]
set t [winfo toplevel $h]
set width [expr {[winfo width $w]-[winfo width $h.cy]-8}]
set minwidth [my config get minwidth]
set minwidth [my Config_get minwidth]
if {$width < $minwidth} {
set width $minwidth
}
set oheight [winfo height $h.cx]
incr oheight 1
foreach child [winfo children $w] {
if {[winfo toplevel $child] ne $w} continue
if {![winfo ismapped $child]} return
if {$child eq $h} continue
puts [list $child [winfo height $child]]
incr oheight [winfo height $child]
}
set minheight [my config get minheight]
set minheight [my Config_get minheight]
set height [expr {[winfo height $w] - $oheight}]
if {$height < $minheight} {
set height $minheight
}
puts [list [self] width $width height $height]
my <canvas> configure -width $width -height $height
my <canvas> configure -scrollregion [my <canvas> bbox all]
|
︙ | | |
Changes to modules/clay-tktable/build/core.tcl.
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
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
|
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
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
|
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
|
package require clay-tk
package require Tktable
clay::define ::clay::tk::hull.tkable {
Array Data
clay set option titlerows {
Option titlerows {
default {1}
native -titlerows
}
clay set option titlecols {
Option titlecols {
default {1}
native -titlecols
}
clay set option cols {
Option cols {
default 0
native -cols
}
clay set option rows {
Option rows {
default 0
native -rows
}
clay set option height {
Option height {
default {}
native -height
}
clay set option width {
Option width {
default {}
native -width
}
clay set option maxheight {
Option maxheight {
default {}
native -maxheight
}
clay set option maxwidth {
Option maxwidth {
default {}
native -maxwidth
}
clay set option multiline {
Option multiline {
default 1
native -multiline
}
clay set option selectmode {
Option selectmode {
default browse
type select
values {single browse multiple extended}
native -selectmode
}
clay set option colstretchmode {
Option colstretchmode {
default none
type select
values {none unset all last}
native -colstretchmode
description {
Specifies one of the following stretch modes for columns to fill extra allocated window
space:
none Columns will not stretch to fill the assigned window space. If the columns are too
narrow, there will be a blank space at the right of the table. This is the default.
unset Only columns that do not have a specific width set will be stretched.
all All columns will be stretched by the same number of pixels to fill the window space
allocated to the table. This mode can interfere with interactive border resizing which
tries to force column width.last The last column will be stretched to fill the window
space allocated to the table.
}
}
clay set option rowstretchmode {
Option rowstretchmode {
default none
type select
values {none unset all last fill}
native -rowstretchmode
description {
Specifies one of the following stretch modes for rows to fill extra allocated window
space:
|
︙ | | |
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
-
+
|
space allocated to the table.
fill The table will get more or less columns
according to the window space allocated to the table. This mode has numerous quirks
and may disappear in the future.
}
}
clay set option multiline {
Option multiline {
native -multiline
default 1
type boolean
}
method build_controls {controlframe} {
}
|
︙ | | |
Changes to modules/clay-tktable/build/spreadsheet.tcl.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
|
-
+
|
###
# Mimic the likes of Microsoft Excel(tm)
###
clay::define ::clay::tk::hull.spreadsheet {
superclass ::clay::tk::hull.tkable
clay set option keycolumn {
Option keycolumn {
default 0
}
method browse {row col} {
my variable prior Data
set TWidget [my clay delegate <widget>]
$TWidget tag configure $row,$col -foreground green
|
︙ | | |
Changes to modules/clay-ui/build/baseclass.tcl.
︙ | | |
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
-
+
|
###
Ensemble action::destroy {} {}
Ensemble action::revert_to_default {} {
set field [my clay get field]
set default [my clay get default]
if {$default in {{} default}} {
set default [my <form> private Option_Default $field]
set default [my <form> private Config_Default $field]
}
my Value_Store $default
}
method ApplySelectedValue newvalue {
if {[set command [my clay get post_command]] ne {}} {
set field [my clay get field]
|
︙ | | |
Added modules/clay-yggdrasil/build/build.tcl.
|
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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
set here [file dirname [file normalize [file join [pwd] [info script]]]]
set version 0.1
set modpath [file dirname $here]
set module clay-yggdrasil
set filename [file tail $modpath]
set fout [open [file join $modpath ${filename}.tcl] w]
dict set map %module% $module
dict set map %version% $version
puts $fout [string map $map {###
# Amalgamated package for %module%
# Do not edit directly, tweak the source in src/ and rerun
# build.tcl
###
package provide %module% %version%
namespace eval ::%module% {}
set ::%module%::version %version%
}]
# Track what files we have included so far
set loaded {build.tcl}
# These files must be loaded in a particular order
foreach file {
core.tcl
} {
lappend loaded $file
set fin [open [file join $here $file] r]
puts $fout "###\n# START: [file tail $file]\n###"
puts $fout [read $fin]
close $fin
puts $fout "###\n# END: [file tail $file]\n###"
}
# These files can be loaded in any order
foreach file [glob [file join $here *.tcl]] {
if {[file tail $file] in $loaded} continue
lappend loaded $file
set fin [open [file join $here $file] r]
puts $fout "###\n# START: [file tail $file]\n###"
puts $fout [read $fin]
close $fin
puts $fout "###\n# END: [file tail $file]\n###"
}
# Provide some cleanup and our final package provide
puts $fout [string map $map {
namespace eval ::%module% {
namespace export *
}
}]
close $fout
###
# Build our pkgIndex.tcl file
###
#if {![package vsatisfies [package provide Tcl] 8.6]} {return}
set fout [open [file join $modpath pkgIndex.tcl] w]
puts $fout [string map $map {# Tcl package index file, version 1.1
# This file is generated by practcl
# and sourced either when an application starts up or
# by a "package unknown" script. It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands. When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.
package ifneeded %module% %version% [list source [file join $dir %module%.tcl]]
}]
close $fout
|
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
Added modules/clay-yggdrasil/build/core.tcl.