Skip to content

Commit 721e171

Browse files
tcl lib files added
1 parent 3999dab commit 721e171

243 files changed

Lines changed: 43821 additions & 0 deletions

File tree

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

src/lib/libtcl9.0.dylib

-7.61 KB
Binary file not shown.

src/lib/libtcl9tk9.0.dylib

1.59 MB
Binary file not shown.

src/lib/libtommath.1.dylib

125 KB
Binary file not shown.

src/lib/tcl9.0/auto.tcl

Lines changed: 711 additions & 0 deletions
Large diffs are not rendered by default.

src/lib/tcl9.0/clock.tcl

Lines changed: 2110 additions & 0 deletions
Large diffs are not rendered by default.

src/lib/tcl9.0/cookiejar0.2/cookiejar.tcl

Lines changed: 746 additions & 0 deletions
Large diffs are not rendered by default.
Lines changed: 292 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,292 @@
1+
# idna.tcl --
2+
#
3+
# Implementation of IDNA (Internationalized Domain Names for
4+
# Applications) encoding/decoding system, built on a punycode engine
5+
# developed directly from the code in RFC 3492, Appendix C (with
6+
# substantial modifications).
7+
#
8+
# This implementation includes code from that RFC, translated to Tcl; the
9+
# other parts are:
10+
# Copyright © 2014 Donal K. Fellows
11+
#
12+
# See the file "license.terms" for information on usage and redistribution of
13+
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
14+
15+
namespace eval ::tcl::idna {
16+
namespace ensemble create -command puny -map {
17+
encode punyencode
18+
decode punydecode
19+
}
20+
namespace ensemble create -command ::tcl::idna -map {
21+
encode IDNAencode
22+
decode IDNAdecode
23+
puny puny
24+
version {::apply {{} {package present tcl::idna} ::}}
25+
}
26+
27+
proc IDNAencode hostname {
28+
set parts {}
29+
# Split term from RFC 3490, Sec 3.1
30+
foreach part [split $hostname "\x2E\u3002\uFF0E\uFF61"] {
31+
if {[regexp {[^-A-Za-z0-9]} $part]} {
32+
if {[regexp {[^-A-Za-z0-9\xA1-\uFFFF]} $part ch]} {
33+
scan $ch %c c
34+
if {$ch < "!" || $ch > "~"} {
35+
set ch [format "\\u%04x" $c]
36+
}
37+
throw [list IDNA INVALID_NAME_CHARACTER $ch] \
38+
"bad character \"$ch\" in DNS name"
39+
}
40+
set part xn--[punyencode $part]
41+
# Length restriction from RFC 5890, Sec 2.3.1
42+
if {[string length $part] > 63} {
43+
throw [list IDNA OVERLONG_PART $part] \
44+
"hostname part too long"
45+
}
46+
}
47+
lappend parts $part
48+
}
49+
return [join $parts .]
50+
}
51+
proc IDNAdecode hostname {
52+
set parts {}
53+
# Split term from RFC 3490, Sec 3.1
54+
foreach part [split $hostname "\x2E\u3002\uFF0E\uFF61"] {
55+
if {[string match -nocase "xn--*" $part]} {
56+
set part [punydecode [string range $part 4 end]]
57+
}
58+
lappend parts $part
59+
}
60+
return [join $parts .]
61+
}
62+
63+
variable digits [split "abcdefghijklmnopqrstuvwxyz0123456789" ""]
64+
# Bootstring parameters for Punycode
65+
variable base 36
66+
variable tmin 1
67+
variable tmax 26
68+
variable skew 38
69+
variable damp 700
70+
variable initial_bias 72
71+
variable initial_n 0x80
72+
73+
variable max_codepoint 0x10FFFF
74+
75+
proc adapt {delta first numchars} {
76+
variable base
77+
variable tmin
78+
variable tmax
79+
variable damp
80+
variable skew
81+
82+
set delta [expr {$delta / ($first ? $damp : 2)}]
83+
incr delta [expr {$delta / $numchars}]
84+
set k 0
85+
while {$delta > ($base - $tmin) * $tmax / 2} {
86+
set delta [expr {$delta / ($base-$tmin)}]
87+
incr k $base
88+
}
89+
return [expr {$k + ($base-$tmin+1) * $delta / ($delta+$skew)}]
90+
}
91+
92+
# Main punycode encoding function
93+
proc punyencode {string {case ""}} {
94+
variable digits
95+
variable tmin
96+
variable tmax
97+
variable base
98+
variable initial_n
99+
variable initial_bias
100+
101+
if {![string is boolean $case]} {
102+
return -code error "\"$case\" must be boolean"
103+
}
104+
105+
set in {}
106+
foreach char [set string [split $string ""]] {
107+
scan $char "%c" ch
108+
lappend in $ch
109+
}
110+
set output {}
111+
112+
# Initialize the state:
113+
set n $initial_n
114+
set delta 0
115+
set bias $initial_bias
116+
117+
# Handle the basic code points:
118+
foreach ch $string {
119+
if {$ch < "\x80"} {
120+
if {$case eq ""} {
121+
append output $ch
122+
} elseif {[string is true $case]} {
123+
append output [string toupper $ch]
124+
} elseif {[string is false $case]} {
125+
append output [string tolower $ch]
126+
}
127+
}
128+
}
129+
130+
set b [string length $output]
131+
132+
# h is the number of code points that have been handled, b is the
133+
# number of basic code points.
134+
135+
if {$b > 0} {
136+
append output "-"
137+
}
138+
139+
# Main encoding loop:
140+
141+
for {set h $b} {$h < [llength $in]} {incr delta; incr n} {
142+
# All non-basic code points < n have been handled already. Find
143+
# the next larger one:
144+
145+
set m inf
146+
foreach ch $in {
147+
if {$ch >= $n && $ch < $m} {
148+
set m $ch
149+
}
150+
}
151+
152+
# Increase delta enough to advance the decoder's <n,i> state to
153+
# <m,0>, but guard against overflow:
154+
155+
if {$m-$n > (0xFFFFFFFF-$delta)/($h+1)} {
156+
throw {PUNYCODE OVERFLOW} "overflow in delta computation"
157+
}
158+
incr delta [expr {($m-$n) * ($h+1)}]
159+
set n $m
160+
161+
foreach ch $in {
162+
if {$ch < $n && ([incr delta] & 0xFFFFFFFF) == 0} {
163+
throw {PUNYCODE OVERFLOW} "overflow in delta computation"
164+
}
165+
166+
if {$ch != $n} {
167+
continue
168+
}
169+
170+
# Represent delta as a generalized variable-length integer:
171+
172+
for {set q $delta; set k $base} true {incr k $base} {
173+
set t [expr {min(max($k-$bias, $tmin), $tmax)}]
174+
if {$q < $t} {
175+
break
176+
}
177+
append output \
178+
[lindex $digits [expr {$t + ($q-$t)%($base-$t)}]]
179+
set q [expr {($q-$t) / ($base-$t)}]
180+
}
181+
182+
append output [lindex $digits $q]
183+
set bias [adapt $delta [expr {$h==$b}] [expr {$h+1}]]
184+
set delta 0
185+
incr h
186+
}
187+
}
188+
189+
return $output
190+
}
191+
192+
# Main punycode decode function
193+
proc punydecode {string {case ""}} {
194+
variable tmin
195+
variable tmax
196+
variable base
197+
variable initial_n
198+
variable initial_bias
199+
variable max_codepoint
200+
201+
if {![string is boolean $case]} {
202+
return -code error "\"$case\" must be boolean"
203+
}
204+
205+
# Initialize the state:
206+
207+
set n $initial_n
208+
set i 0
209+
set first 1
210+
set bias $initial_bias
211+
212+
# Split the string into the "real" ASCII characters and the ones to
213+
# feed into the main decoder. Note that we don't need to check the
214+
# result of [regexp] because that RE will technically match any string
215+
# at all.
216+
217+
regexp {^(?:(.*)-)?([^-]*)$} $string -> pre post
218+
if {[string is true -strict $case]} {
219+
set pre [string toupper $pre]
220+
} elseif {[string is false -strict $case]} {
221+
set pre [string tolower $pre]
222+
}
223+
set output [split $pre ""]
224+
set out [llength $output]
225+
226+
# Main decoding loop:
227+
228+
for {set in 0} {$in < [string length $post]} {incr in} {
229+
# Decode a generalized variable-length integer into delta, which
230+
# gets added to i. The overflow checking is easier if we increase
231+
# i as we go, then subtract off its starting value at the end to
232+
# obtain delta.
233+
234+
for {set oldi $i; set w 1; set k $base} 1 {incr in} {
235+
if {[set ch [string index $post $in]] eq ""} {
236+
throw {PUNYCODE BAD_INPUT LENGTH} "exceeded input data"
237+
}
238+
if {[string match -nocase {[a-z]} $ch]} {
239+
scan [string toupper $ch] %c digit
240+
incr digit -65
241+
} elseif {[string match {[0-9]} $ch]} {
242+
set digit [expr {$ch + 26}]
243+
} else {
244+
throw {PUNYCODE BAD_INPUT CHAR} \
245+
"bad decode character \"$ch\""
246+
}
247+
incr i [expr {$digit * $w}]
248+
set t [expr {min(max($tmin, $k-$bias), $tmax)}]
249+
if {$digit < $t} {
250+
set bias [adapt [expr {$i-$oldi}] $first [incr out]]
251+
set first 0
252+
break
253+
}
254+
if {[set w [expr {$w * ($base - $t)}]] > 0x7FFFFFFF} {
255+
throw {PUNYCODE OVERFLOW} \
256+
"excessively large integer computed in digit decode"
257+
}
258+
incr k $base
259+
}
260+
261+
# i was supposed to wrap around from out+1 to 0, incrementing n
262+
# each time, so we'll fix that now:
263+
264+
if {[incr n [expr {$i / $out}]] > 0x7FFFFFFF} {
265+
throw {PUNYCODE OVERFLOW} \
266+
"excessively large integer computed in character choice"
267+
} elseif {$n > $max_codepoint} {
268+
if {$n >= 0x00D800 && $n < 0x00E000} {
269+
# Bare surrogate?!
270+
throw {PUNYCODE NON_BMP} \
271+
[format "unsupported character U+%06x" $n]
272+
}
273+
throw {PUNYCODE NON_UNICODE} "bad codepoint $n"
274+
}
275+
set i [expr {$i % $out}]
276+
277+
# Insert n at position i of the output:
278+
279+
set output [linsert $output $i [format "%c" $n]]
280+
incr i
281+
}
282+
283+
return [join $output ""]
284+
}
285+
}
286+
287+
package provide tcl::idna 1.0.1
288+
289+
# Local variables:
290+
# mode: tcl
291+
# fill-column: 78
292+
# End:
Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
2+
package ifneeded cookiejar 0.2.0 [list source [file join $dir cookiejar.tcl]]
3+
package ifneeded tcl::idna 1.0.1 [list source [file join $dir idna.tcl]]
69.2 KB
Binary file not shown.

src/lib/tcl9.0/foreachline.tcl

Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,25 @@
1+
# foreachLine:
2+
# Iterate over the contents of a file, a line at a time.
3+
# The body script is run for each, with variable varName set to the line
4+
# contents.
5+
#
6+
# Copyright © 2023 Donal K Fellows.
7+
#
8+
# See the file "license.terms" for information on usage and redistribution
9+
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
10+
#
11+
12+
proc foreachLine {varName filename body} {
13+
upvar 1 $varName line
14+
set f [open $filename "r"]
15+
try {
16+
while {[gets $f line] >= 0} {
17+
uplevel 1 $body
18+
}
19+
} on return {msg opt} {
20+
dict incr opt -level
21+
return -options $opt $msg
22+
} finally {
23+
close $f
24+
}
25+
}

0 commit comments

Comments
 (0)