Artifact
c9ae90bed7e9ab0cc758ded8296ed485d5020d5f
File
features/basic.th1
— part of check-in
[82270c3d74]
at
2015-02-09 01:52:44
on branch trunk
— Split up th1x into individual sections (basic control structures, str, sql
functions, and github-specific ui:: functions). Rename changelog to hooks.
(user:
mario
size: 1329)
0000: 0a 23 2d 2d 20 50 72 65 2d 69 6e 63 72 65 6d 65 .#-- Pre-increme
0010: 6e 74 20 20 5b 2b 2b 20 76 61 72 6e 61 6d 65 5d nt [++ varname]
0020: 0a 70 72 6f 63 20 2b 2b 20 7b 76 61 72 6e 61 6d .proc ++ {varnam
0030: 65 7d 20 7b 0a 20 20 20 75 70 76 61 72 20 31 20 e} {. upvar 1
0040: 24 76 61 72 6e 61 6d 65 20 69 0a 20 20 20 72 65 $varname i. re
0050: 74 75 72 6e 20 5b 75 70 6c 65 76 65 6c 20 31 20 turn [uplevel 1
0060: 22 73 65 74 20 7b 24 76 61 72 6e 61 6d 65 7d 20 "set {$varname}
0070: 5b 65 78 70 72 20 31 2b 24 69 5d 22 5d 0a 7d 0a [expr 1+$i]"].}.
0080: 0a 23 2d 2d 20 74 65 72 6e 61 72 79 20 2f 20 69 .#-- ternary / i
0090: 66 2d 73 68 6f 72 74 68 61 6e 64 20 28 63 6f 6e f-shorthand (con
00a0: 64 2f 74 68 65 6e 2f 65 6c 73 65 20 6d 61 79 20 d/then/else may
00b0: 62 65 20 6c 69 74 65 72 61 6c 73 2c 20 6f 72 20 be literals, or
00c0: 7b 5b 65 78 70 72 65 73 73 69 6f 6e 73 5d 7d 20 {[expressions]}
00d0: 74 68 65 6d 73 65 6c 76 65 73 29 0a 70 72 6f 63 themselves).proc
00e0: 20 3f 3a 20 7b 63 6f 6e 64 20 74 68 65 6e 20 65 ?: {cond then e
00f0: 6c 73 65 7d 20 7b 0a 20 20 20 75 70 6c 65 76 65 lse} {. upleve
0100: 6c 20 31 20 22 69 66 20 7b 24 63 6f 6e 64 7d 20 l 1 "if {$cond}
0110: 7b 20 72 65 74 75 72 6e 20 24 74 68 65 6e 3b 20 { return $then;
0120: 7d 20 65 6c 73 65 20 7b 20 72 65 74 75 72 6e 20 } else { return
0130: 24 65 6c 73 65 3b 20 7d 22 0a 7d 0a 0a 23 2d 2d $else; }".}..#--
0140: 20 69 6e 66 6f 20 65 78 69 73 74 73 20 73 68 6f info exists sho
0150: 72 74 68 61 6e 64 0a 70 72 6f 63 20 69 73 73 65 rthand.proc isse
0160: 74 20 7b 76 61 72 6e 61 6d 65 7d 20 7b 0a 20 20 t {varname} {.
0170: 20 72 65 74 75 72 6e 20 5b 75 70 6c 65 76 65 6c return [uplevel
0180: 20 31 20 22 69 6e 66 6f 20 65 78 69 73 74 73 20 1 "info exists
0190: 7b 24 76 61 72 6e 61 6d 65 7d 22 5d 0a 7d 0a 0a {$varname}"].}..
01a0: 23 2d 2d 20 73 74 72 69 6e 67 20 65 71 75 61 6c #-- string equal
01b0: 69 74 79 20 73 68 6f 72 74 68 61 6e 64 0a 70 72 ity shorthand.pr
01c0: 6f 63 20 65 71 20 7b 73 74 72 31 20 73 74 72 32 oc eq {str1 str2
01d0: 7d 20 7b 0a 20 20 20 72 65 74 75 72 6e 20 5b 65 } {. return [e
01e0: 78 70 72 20 7b 24 73 74 72 31 20 65 71 20 24 73 xpr {$str1 eq $s
01f0: 74 72 32 7d 5d 0a 7d 0a 0a 23 2d 2d 20 77 68 69 tr2}].}..#-- whi
0200: 6c 65 20 6c 6f 6f 70 0a 70 72 6f 63 20 77 68 69 le loop.proc whi
0210: 6c 65 20 7b 63 6f 6e 64 69 74 69 6f 6e 20 63 6f le {condition co
0220: 64 65 7d 20 7b 0a 20 20 20 72 65 74 75 72 6e 20 de} {. return
0230: 5b 75 70 6c 65 76 65 6c 20 31 20 22 66 6f 72 20 [uplevel 1 "for
0240: 7b 7d 20 7b 24 63 6f 6e 64 69 74 69 6f 6e 7d 20 {} {$condition}
0250: 7b 7d 20 7b 24 63 6f 64 65 7d 22 5d 0a 7d 0a 0a {} {$code}"].}..
0260: 23 2d 2d 20 66 6f 72 65 61 63 68 20 56 41 52 20 #-- foreach VAR
0270: 22 61 62 63 20 78 79 7a 20 31 32 33 22 20 7b 20 "abc xyz 123" {
0280: 70 75 74 73 20 22 28 24 56 41 52 29 20 22 20 7d puts "($VAR) " }
0290: 0a 70 72 6f 63 20 66 6f 72 65 61 63 68 20 7b 76 .proc foreach {v
02a0: 61 72 6e 61 6d 65 20 6c 69 73 74 20 63 6f 64 65 arname list code
02b0: 7d 20 7b 0a 20 20 20 75 70 76 61 72 20 31 20 24 } {. upvar 1 $
02c0: 76 61 72 6e 61 6d 65 20 76 61 6c 0a 20 20 20 66 varname val. f
02d0: 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 20 7b 24 or {set i 0} {$
02e0: 69 20 3c 20 5b 6c 6c 65 6e 67 74 68 20 24 6c 69 i < [llength $li
02f0: 73 74 5d 7d 20 20 7b 2b 2b 20 69 7d 20 7b 0a 20 st]} {++ i} {.
0300: 20 20 20 20 20 73 65 74 20 76 61 6c 20 5b 6c 69 set val [li
0310: 6e 64 65 78 20 24 6c 69 73 74 20 24 69 5d 0a 20 ndex $list $i].
0320: 20 20 20 20 20 75 70 6c 65 76 65 6c 20 31 20 22 uplevel 1 "
0330: 24 63 6f 64 65 22 0a 20 20 20 7d 0a 7d 0a 0a 23 $code". }.}..#
0340: 2d 2d 20 41 20 73 77 69 74 63 68 20 73 74 61 74 -- A switch stat
0350: 65 6d 65 6e 74 2e 0a 23 0a 23 20 73 77 69 74 63 ement..#.# switc
0360: 68 20 22 76 61 6c 22 20 7b 0a 23 20 20 20 20 20 h "val" {.#
0370: 20 20 20 22 63 6d 70 31 22 20 7b 63 6f 64 65 31 "cmp1" {code1
0380: 7d 0a 23 20 20 20 20 20 20 20 20 22 63 6d 70 32 }.# "cmp2
0390: 22 20 7b 63 6f 64 65 32 7d 0a 23 20 20 20 20 20 " {code2}.#
03a0: 20 20 20 22 63 6d 70 33 22 20 7b 63 6f 64 65 33 "cmp3" {code3
03b0: 7d 0a 23 20 20 20 7b 7b 64 65 66 61 75 6c 74 7d }.# {{default}
03c0: 7d 20 7b 63 6f 64 65 4e 7d 0a 23 20 7d 0a 23 0a } {codeN}.# }.#.
03d0: 70 72 6f 63 20 73 77 69 74 63 68 20 7b 63 6f 6d proc switch {com
03e0: 70 61 72 65 5f 76 61 6c 75 65 20 76 61 6c 5f 63 pare_value val_c
03f0: 6f 64 65 5f 70 61 69 72 73 7d 20 7b 0a 20 20 20 ode_pairs} {.
0400: 73 65 74 20 6c 65 6e 20 5b 6c 6c 65 6e 67 74 68 set len [llength
0410: 20 24 76 61 6c 5f 63 6f 64 65 5f 70 61 69 72 73 $val_code_pairs
0420: 5d 0a 20 20 20 23 20 6c 6f 6f 70 20 6f 76 65 72 ]. # loop over
0430: 20 63 6f 6d 70 61 72 65 20 76 61 6c 75 65 73 20 compare values
0440: 2b 20 63 6f 64 65 20 70 61 69 72 73 0a 20 20 20 + code pairs.
0450: 66 6f 72 20 20 7b 73 65 74 20 6e 20 30 7d 20 20 for {set n 0}
0460: 7b 24 6e 20 3c 20 24 6c 65 6e 7d 20 20 7b 2b 2b {$n < $len} {++
0470: 20 6e 7d 20 7b 0a 20 20 20 20 20 20 73 65 74 20 n} {. set
0480: 63 6d 70 20 5b 6c 69 6e 64 65 78 20 24 76 61 6c cmp [lindex $val
0490: 5f 63 6f 64 65 5f 70 61 69 72 73 20 24 6e 5d 3b _code_pairs $n];
04a0: 0a 20 20 20 20 20 20 69 66 20 7b 5b 65 78 70 72 . if {[expr
04b0: 20 24 63 6d 70 20 65 71 20 24 63 6f 6d 70 61 72 $cmp eq $compar
04c0: 65 5f 76 61 6c 75 65 20 7c 7c 20 24 63 6d 70 20 e_value || $cmp
04d0: 65 71 20 7b 7b 64 65 66 61 75 6c 74 7d 7d 20 5d eq {{default}} ]
04e0: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 72 65 74 } {. ret
04f0: 75 72 6e 20 5b 75 70 6c 65 76 65 6c 20 31 20 5b urn [uplevel 1 [
0500: 6c 69 6e 64 65 78 20 24 76 61 6c 5f 63 6f 64 65 lindex $val_code
0510: 5f 70 61 69 72 73 20 5b 2b 2b 20 6e 5d 5d 5d 3b _pairs [++ n]]];
0520: 0a 20 20 20 20 20 20 7d 0a 20 20 20 7d 0a 7d 0a . }. }.}.
0530: 0a .