wiki

本页面只读。您可以查看源文件，但不能更改它。如果您觉得这是系统错误，请联系管理员。
====== tcl语法速查 ======

[[语法:tcl_synopsys]]

[[语法:tcl_tessent]]


参考： 
  * [[http://vmcc.vicp.net:9090/tcl86_doc/index.htm|tcl86_doc]]    

  * [[linux:正则表达式]]

{{ :语法:tcl-tk入门经典_第二版_.pdf |}}

{{ :语法:tcl_and_the_tk_toolkit_john_k._ousterhout_.pdf |}}

===== - 查看tcl版本 =====
进入tcl命令tclsh后，输入以下内容：

''info patchlevel''


安装tcl:

<code>yum install -y tcl-devel.x86_64 tcl.x86_64</code>

===== - regexp正则表达式 =====

语法：

''regexp optionalSwitches patterns searchString fullMatch subMatch1 ... subMatchn''

-nocase : 用于忽略大小写。


==== - 正则表达式规则 ====
更详细的tcl正则表达式规则请查看 http://vmcc.vicp.net:9090/tcl86_doc/re_syntax.htm

tcl支持三种RE规则，BRE,ERE,ARE。默认是使用的ARE。

  * BRE是basic REs，就是vim和grep使用正则表达式规则。

  * ERE是extended REs， 是egrep使用的规则。

  * ARE是在ERE的基础上再扩展，跟perl的有点相似，但细节有些区别。


<code tcl>
# [[:<:]]和[[:>:]]与\<和\>和功能一样, 用于匹配word边界
# 三种规则模式都支持[[:<:]] [[:>:]]，但仅BRE支持 \< \>

set a 123

## 使用ARE规则:  -- 默认规则，不用加任何修饰
if { [regexp {[[:<:]]123[[:>:]]} $a] } {
  puts "matched"
}

## 使用BRE规则： -- 加个(?b)修饰符就表示使用BRE规则
if { [regexp {(?b)23\>} $a] } {
  puts "matched"
}

## 使用ERE规则：  -- 加个(?e)修饰符就表示使用ERE规则
if { [regexp {(?e)23[[:>:]]} $a] } {
  puts "matched"
}
</code>



==== - 基本用法 ====

<code tcl>

set name "day day up"

if [regexp -nocase {day} $name] {
    puts "matched"
}

if [regexp -nocase "day" $name] {
    puts "matched2"
}

if [regexp -nocase "cat" $name] {
    puts "matched3"
} else {
    puts "not matched3"
}

</code>

运行结果：
<code>
matched
matched2
not matched3
</code>


<code tcl>

% set a "cdb"
cdb
% if {![regexp {c} $a]} { puts "haha" }
% set a "adb"
adb
% if {![regexp {c} $a]} { puts "haha" }
haha
%

</code>

==== - {}与""的区别 ====
  * {}里面不能做变量替换，类似于像\s, [, ]这种功能符不需要在前面加转义
  * ""里面支持变量替换，如果要输入功能符需要在前面加转义，即  \[ 表示为[,  \]表示为]， 简单理解该表达式打印出来的值就是我们预期的值，所以在打印的时候要考虑转义。

<code tcl>
% set a {\[}
\[
%
% set a "\\\["
\[

</code>

<code tcl>
%
% set a "af"
af
% set b "af <= 3"
af <= 3
% regexp "af " $b
1
% regexp "$a " $b
1
% regexp "af\s" $b
0
% regexp "$a\s" $b
0
% regexp "af\\s" $b
1
% regexp {$a\s} $b
0
% regexp {\s} $b
1
% regexp "$a\\s<=" $b
1
% regexp "$a\\s*<=" $b
1
%

</code>


==== - 匹配多个条件 ====

匹配多个条件时，直接使用 | 符号

<code tcl>

% set a "hello you"
hello you
% if {[regexp {hello|you} $a]} {puts "hit"}
hit
% if {[regexp {hello|xou} $a]} {puts "hit"}
hit
% if {[regexp {hellof|xou} $a]} {puts "hit"}
% if {[regexp {hellof|you} $a]} {puts "hit"}
hit
%

</code>



==== - submatch， 子匹配 ====

<code tcl>
set name "day day up"

if [regexp -nocase {(day) (day) (up)} $name m1 m2 m3 m4] {
    puts "m1 = $m1, m2 = $m2, m3 = $m3, m4 = $m4"
}


if [regexp -nocase {(\w+) (\w+) (\w+)} $name m1 m2 m3 m4] {
    puts "m1 = $m1, m2 = $m2, m3 = $m3, m4 = $m4"
}

</code>

运行结果：

<code>
m1 = day day up, m2 = day, m3 = day, m4 = up
m1 = day day up, m2 = day, m3 = day, m4 = up
</code>


==== - 非贪婪匹配模式 ====

非贪婪模式，就是在匹配满足的情况下，尽量少的匹配字符。

贪婪模式，就是尽量多在匹配字符，默认为贪婪模式。


^ 贪婪匹配   ^ 非贪婪匹配   ^ 说明                     ^
| *      | *?      | 非贪婪模式就是在正常匹配模式后面加一个?号  |
| +      | +?      |                        |
| ?      | ??      |                        |
| {m}    | {m}?    |                        |
| {m,}   | {m,}?   |                        |
| {m,n}  | {m,n}?  |                        |



==== - regsub正则表达式替换 ====
语法：
''regsub ?switches? exp string subSpec ?varName?''

当switches为\\ 
-all，表示执行多次替换，类似于vim替换的g操作。 \\ 
-nocase，表示匹配时忽略大小写。

<code tcl>
#　将abc替换为hello, 并且将替换后的内容保存到变量c
% regsub  {\w+} "abc def" "hello" c
1
% echo $c
"hello def"

# 替换abc成hello
% regsub  {\w+} "abc def" "hello"
hello def

% set d [regsub  {\w+} "abc def" "hello" ]
hello def
% echo $d
"hello def"
%
</code>


==== - 使用变量作为正则表达式 ====

<code tcl>

%
%
% set c "da\[0\]\[2\]"
da[0][2]
% set c [regsub -all {\]} $c {\]}]
da[0\][2\]
% set c [regsub -all {\[} $c {\\[}]
da\[0\]\[2\]
%
% set b "da\[0\]\[2\] = 38"
da[0][2] = 38
% regexp $c $b  ;  ## 这里就是用$c里面的值来匹配$b里面的内容， $c是一个变量，不是固定的string
1
%

</code>


==== - 使用\逃逸 ====

<code tcl>
%
% set c "da\[0\]\[2\]"
da[0][2]
% regsub -all {\]} $c {\\}
da[0\[2\
% regsub -all {\]} $c {\]}
da[0\][2\]
% regsub -all {\]} $c {\a}
da[0\a[2\a
%
% regsub -all {\[} $c {\\}
da\0]\2]
% regsub -all {\[} $c {\[}
da\[0]\[2]
% regsub -all {\[} $c {\a}
da\a0]\a2]
%
</code>


==== - 使用\1 \2 ====

<code>
% set a "abc.ef"
abc.ef
% regsub {(.*c)} $a {\1}
abc.ef
% set ret [regsub {(.*c).*} $a {\1}]
abc
%
</code>
===== - number =====

integer value: 335 (decimal), 0o517 (octal), 0x14f (hexadecimal), 0b101001111 (binary).

===== - string =====

==== - string length长度 ====


<code tcl>
% set len [string length "abc"]
3
% echo $len
</code>


==== - string compare ====
string compare ?-nocase? ?-length length? string1 string2

返回结果为0表示相等， 返回-1, 表示string1 < string2，  返回1表示string1 > string2。

<code tcl>
% string compare "abc" "abc"
0
% string compare "abc" "abc0"
-1
% string compare -nocase "abc" "ABc"
0

</code>

==== - string cat ====
Concatenate the given strings just like placing them directly next to each other and return the resulting compound string. If no strings are present, the result is an empty string.

<code tcl>
string cat ?string1? ?string2...?

set new_str [string cat "hello " "world"]
puts $new_str
#打印hello world

</code>
==== - string replace ====

<code tcl>
string replace string first last ?newstring?


string replace "0x55,hello" 0 3
# 返回,hello


string replace "0x55,hello" 0 3 "0x33"
# 将0x55替换为0x33

</code>
Removes a range of consecutive characters from string, If newstring is specified, then it is placed in the removed character range.
==== - string range ====

<code tcl>
string range string first last

string range "hello, world"  0 3

#返回hell
</code>
Returns a range of consecutive characters from string
==== - string repeat ====

<code tcl>
string repeat string count

string repeat "0" 4
</code>
Returns string repeated count number of times.

==== - string 大小写转换 ====
**转大写**

<code>
string toupper string ?first? ?last?
</code>

**转小写**
<code>
string tolower string ?first? ?last?
</code>


===== - 布尔值 =====
https://www.bilibili.com/read/cv16148884/

<code>
布尔值是编程语言中，普遍存在的一种数据类型。即便没有这种数据类型，也会有这个概念，比如Tcl/Tk。

布尔值表示 "是、非" 或者 "真、假" 这么一个成对的概念。Tcl语言里都是字符串，
它通过一些特定字符表示布尔值。首先，很好理解的表示布尔值的单词（大小写均可）：

yes, no
true, false
on, off
数值 1, 0
</code>

<code tcl>
% set a "true"
true
%  if {$a} {puts haha}
haha
% string is boolean "true"
1
# 变量本身也是用string存储的，也可以直接和字符串比较
%  if {$a=="true"} {puts haha}
haha
</code>

<code>
## 布尔值单词的一部分，也被认为是布尔值
# 以下都代表"真"
string is boolean "t"
string is boolean "tr"
string is boolean "tru"
string is boolean "ye"
# 对应的：f, fa, fal, fals, n 都代表"假"

# 注意：字母 o 不会被认为是布尔值，因为on和off开头都是o
string is boolean o
>> 0
# 但是of可以用来表示"假"，因为它是off的一部分
</code>

===== - 进制转换 =====

==== - 转为二进制数 ====

<code tcl>
% format "%b" 3
11
% format "%b" 0x3
11
% format "%b" 0x30
110000
</code>

==== - 转为16进制数 ====

<code tcl>
% format "%x" 0x30
30
% format "%x" 30
1e
% format "0x%x" 30
0x1e
%
</code>


==== - 转为10进制数 ====

<code tcl>
% format "%d" 0x30
48
% format "%d" 30
30
%
</code>


==== - 产生递进的二进制数 ====

<file tcl t3.tcl>
for {set i 0} {$i <16} {incr i} {
    set hex_str [format "%04b" $i]
    puts -nonewline "hex_str = $hex_str"

    puts -nonewline "  bit\[3:0\] ="
    for {set j 3} {$j >= 0} {incr j -1} {
        set idx [expr 3-$j]
        set bit_str [string range $hex_str $idx $idx]
        puts -nonewline "  $bit_str"
    }
    puts ""
}
</file>
运行结果：

<code>
hex_str = 0000  bit[3:0] =  0  0  0  0
hex_str = 0001  bit[3:0] =  0  0  0  1
hex_str = 0010  bit[3:0] =  0  0  1  0
hex_str = 0011  bit[3:0] =  0  0  1  1
hex_str = 0100  bit[3:0] =  0  1  0  0
hex_str = 0101  bit[3:0] =  0  1  0  1
hex_str = 0110  bit[3:0] =  0  1  1  0
hex_str = 0111  bit[3:0] =  0  1  1  1
hex_str = 1000  bit[3:0] =  1  0  0  0
hex_str = 1001  bit[3:0] =  1  0  0  1
hex_str = 1010  bit[3:0] =  1  0  1  0
hex_str = 1011  bit[3:0] =  1  0  1  1
hex_str = 1100  bit[3:0] =  1  1  0  0
hex_str = 1101  bit[3:0] =  1  1  0  1
hex_str = 1110  bit[3:0] =  1  1  1  0
hex_str = 1111  bit[3:0] =  1  1  1  1
</code>

==== - com_number set_bits get_bits ====

<code tcl>

proc h2b {h} {
    switch $h {
        0       { set ret 0000 }
        1       { set ret 0001 }
        2       { set ret 0010 }
        3       { set ret 0011 }
        4       { set ret 0100 }
        5       { set ret 0101 }
        6       { set ret 0110 }
        7       { set ret 0111 }
        8       { set ret 1000 }
        9       { set ret 1001 }
        a       { set ret 1010 }
        b       { set ret 1011 }
        c       { set ret 1100 }
        d       { set ret 1101 }
        e       { set ret 1110 }
        f       { set ret 1111 }
        default { set ret 0000 }
    }
    # set ret [format "%04b" "0x$h"]
    return $ret
}
proc hex2bin {hex_value} {
    set hex_value [regsub -nocase {0x} $hex_value {}]
    set len [string length $hex_value]
    set bins "0b"
    for {set i 0} {$i<$len} {incr i} {
        set tmp [string range $hex_value $i $i]
        #set bins [string cat $bins [format "%04b" "0x$tmp"]]
        set tmp [h2b $tmp]
        set bins "$bins$tmp"
    }
    return $bins
}
proc bin2hex {bins} {
    set bins [regsub -nocase {0b} $bins {}]
    set len [string length $bins]
    set padding ""
    if { [expr $len%4] != 0} {
        set padding [string repeat "0" [expr (4-$len%4)]]
    }

    set bins "$padding$bins"
    set len [string length $bins]
    set hexs "0x"
    for {set i 0} {$i<[expr $len/4]} {incr i} {
        set tmp [string range $bins [expr 0+$i*4] [expr 3+$i*4]]
        #set hexs [string cat $hexs [format "%0x" "0b$tmp"]]
        set tmp [format "%0x" "0b$tmp"]
        set hexs "$hexs$tmp"
    }
    return $hexs
}
proc expandbins {width bins} {
    set bins [regsub -nocase {0b} $bins {}]
    set len [string length $bins]
    if { $len > $width} {
        return [string range $bins [expr $len-$width] [expr $len-1]]
    } else {
        set padding [string repeat "0" [expr $width-$len]]
        return "$padding$bins"
    }
}

proc get_bins {width hex_value msb lsb} {
    set bins [hex2bin $hex_value]
    set bins [expandbins $width $bins]
    set bins [string range $bins [expr $width-$msb-1] [expr $width-$lsb-1]]

    return $bins
}
proc get_bits {width hex_value msb lsb} {
    set bins [get_bins $width $hex_value $msb $lsb]
    return [bin2hex $bins]
}

proc set_bits {width hex_value msb lsb new} {
    set bins [hex2bin $hex_value]
    set bins [expandbins $width $bins]

    set new_bins [get_bins [expr $msb-$lsb+1] $new [expr $msb-$lsb] 0]

    set replace_bins [string replace $bins [expr $width-$msb-1] [expr $width-$lsb-1] $new_bins]
    return [bin2hex $replace_bins]
}

</code>


<code tcl>
%
% get_bits 32 "0x33" 3 0
0x3
% get_bits 32 "0x33" 1 0
0x3
% get_bits 32 "0x33" 7 0
0x33
%
</code>
===== - list =====

==== - 创建list ====

<code tcl>
set list_a {1 2 3}
#or
set list_b [list 4 5 6]
</code>

==== - list 长度 ====
<code tcl>
set len [llength $list_a]
</code>

==== - list index索引 ====
<code tcl>
set item0 [lindex $list_a 0]

% set a {1 2 3 4 5}
1 2 3 4 5
% lindex $a 0
1
% lindex $a 1
2
% lindex $a end
5
% lindex $a end-1
4
% lindex $a end-2
3
</code>


==== - list sort排序 ====
<code tcl>
set list_a_sorted [lsort $list_a]
</code>

<code tcl>
% set a {a0 b0 b2 b3 b10 b20 b22 b30}
a0 b0 b2 b3 b10 b20 b22 b30
% lsort $a
a0 b0 b10 b2 b20 b22 b3 b30
% lsort -dictionary $a
a0 b0 b2 b3 b10 b20 b22 b30
%
</code>
==== - list lappend追加 ====
可以用作push功能使用

<code tcl>
lappend listName value
</code>

==== - lassign ====
<code tcl>
% split {a:2} {:}
a 2
% lassign  [split {a:2} {:}]  m1 m2
% puts $m1
a
% puts $m2
2
</code>
==== - list 嵌套====
<code tcl>
% set a {1 2}
1 2
% set b {3 4}
3 4
% set c {}
% lappend c $a
{1 2}
% lappend c $b
{1 2} {3 4}
% echo $c
"{1 2} {3 4}"
% foreach item $c { puts "-----"; foreach i $item {puts $i}}
-----
1
2
-----
3
4
% concat $a $b $c
1 2 3 4 {1 2} {3 4}
% llength [concat $a $b $c]
6


# 注意lrange返回的是由first 到last元素组成的数据，如果原来的元素是数组，会被转换成字符串。
% foreach i [lrange $c 0 0] { puts $i}
1 2
% set a [lrange $c 0 0]
{1 2}
% lindex $a 0; # a只有一个元素，那就是 “1 2”， a已经不是list了。
1 2
</code>

==== - list concat ====
<code tcl>
% concat a b {c d e}
a b c d e

% set a {1 2 3}
1 2 3
% set b {u v w}
u v w
% concat $a $b
1 2 3 u v w
% concat a b $b
a b u v w
</code>
==== - list 删除第一个元素 ====

可以用作pop功能使用

<code tcl>
set listName [lrange $listName 1 end]
</code>
==== - linsert 插入 ====
语法：
<code tcl>
linsert list index ?element element ...?
</code>

This command ''produces a new list'' from list by inserting all of the element arguments just before the index'th element of list. 


举例：  注意，linsert后面需要使用$带变量名。
<code tcl>
set oldList {the fox jumps over the dog}
set midList [linsert $oldList 1 quick]
set newList [linsert $midList end-1 lazy]
# The old lists still exist though...
set newerList [linsert [linsert $oldList end-1 quick] 1 lazy]
</code>


==== - lreplace ====
lreplace — Replace elements in a list with new elements

lreplace list first last ?element element ...?

Replacing an element of a list with another:

<code tcl>
% lreplace {a b c d e} 1 1 foo
a foo c d e
</code>

Replacing two elements of a list with three:

<code tcl>
% lreplace {a b c d e} 1 2 three more elements
a three more elements d e
</code>


Deleting the last element from a list in a variable:

<code tcl>
% set var {a b c d e}
a b c d e
% set var [lreplace $var end end]
a b c d
</code>


==== - lrange ====
lrange — Return one or more adjacent elements from a list

lrange list first last

EXAMPLES

Selecting the first two elements:
<code tcl>
% lrange {a b c d e} 0 1
a b
</code>

Selecting the last three elements:
<code tcl>
% lrange {a b c d e} end-2 end
c d e
</code>

Selecting everything except the first and last element:
<code tcl>
% lrange {a b c d e} 1 end-1
b c d
</code>


==== - split string to list ====

split — Split a string into a proper Tcl list

<code tcl>
% set a "hello world"
hello world
% split $a { }
hello world
% llength [split $a { }]
2
% foreach item [split $a { }] {
puts $item
}
hello
world
</code>


==== - 技巧 ====
目前还没有找到在递归调用中返回return list的方法， 目前自己使用的是替代方案，采用一个global的list， 然后在递归函数里直接修改该list即可。


===== - array数组 =====
==== - 创建数组 ====
语法： ''set ArrayName(Index) value''

<code tcl>
set ar(0) 1
set ar(1) 2
set ar(2) 3

puts $ar(0)
puts $ar(1)
puts $ar(2)
</code>

==== - array set ====
初始化设置array,  参数必须是要偶数个，name-value是成对出现的
<code tcl>
% array set c {a 1 b 2 c 3 d 4}
% echo $c(a)
1
% echo $c(b)
2
% echo $c(c)
3
% echo $c(d)
4
</code>

==== - array size ====
<code tcl>
% array size c
6
</code>

==== - array name ====
用于搜索array里面是否出现xx name关键字

<code tcl>
array names arrayName ?mode? ?pattern?
Returns a list containing the names of all of the elements in the array that match pattern. 
Mode may be one of -exact, -glob, or -regexp.   -glob is default
</code> 

<code tcl>
% array set c {a 1 b 2 c 3 d 4}
% echo $c(a)
1
% echo $c(b)
2
% echo $c(c)
3
% echo $c(d)
4
% set c(a1) 1.1
1.1
% set c(b1) 2.1
2.1
% array name c -regexp a
a a1
% array name c -regexp b
b b1
% array name c -exact a
a
% array name c -exact a1
a1
% array name c -exact b
b
% array name c -exact b1
b1
% array name c -exact a2   #  a2就不存在
% if {[array name c -exact a2] == ""} {  echo "not exist" }
"not exist"
%
% if {[array name c -exact a1] == "a1"} {  echo "exist" }
exist
%



% array name c a
a
% array name c a1
a1
% array name c a*
a a1
%
</code>

==== - array迭代 ====
<code tcl>
for {set i 0} {$i < [array size ar]} {incr i} {
    puts "ar $i : $ar($i)"
}
</code>

==== - array 非数字index ====
<code tcl>

% set TD(a)   a
a
% set TD(a,b) a,b
a,b
% array size TD
2
% set id [array startsearch TD]
s-1-TD
% array nextelement TD $id
a
% array nextelement TD $id
a,b
% array nextelement TD $id
% array donesearch TD $id
%
</code>


==== - 生成连续数字list ====
tcl语言并没有原生类似perl 1..10产生10个连续数字的语法，可以使用类似以下proc的方式产生。

<code tcl>
proc range {start end} {
    set list {}
    for {set i $start} {$i <= $end} {incr i} {
        lappend list $i
    }
    return $list
}
set numbers [range 1 10]  ;# 生成 1 到 10 的列表
</code>


===== - dict字典 =====

语法

<code tcl>
dict set dictname key value
# or 
dict create key1 value1 key2 value2 .. keyn valuen
</code>

==== - 创建dict ====

<code tcl>

#创建一个空DICT

%set mdict [dict create]
%dict keys $mdict


# 创建dict,并赋值
dict set ages zhangsan 30;  往ages添加zhangsan
dict set ages lisi 40;  往ages添加lisi

#or 

set weigths [dict create "a" 0.2 "b" 0.3 "c" 0.4 "d" 0.66]
</code>


==== - dict unset 删除某个key ====
<code tcl>
dict unset dictionaryVariable key ?key ...?

dict unset ages lisi;  #删除lisi
</code>

This operation (the companion to dict set) takes the name of a variable containing a dictionary value and places an updated dictionary value in that variable that does not contain a mapping for the given key. Where multiple keys are present, this describes a path through nested dictionaries to the mapping to remove. At least one key must be specified, but the last key on the key-path need not exist. All other components on the path must exist. The updated dictionary value is returned.
==== - dict size大小 ====
<code tcl>
dict size $weigths
</code>



==== - dict for ====
<code tcl>
dict for {key value} $dic {
    puts "$key--$value"
}
</code>


==== - dict get value ====
<code tcl>
dict get $weigths a


foreach {key value} [dict get $weigths] {
    puts "$key--$value"
}

set value [dict get $weigths "aa"]

</code>

==== - dict keys ====

<code tcl>
dict keys $weigths
</code>

==== - dict迭代 ====
<code tcl>
foreach item [dict keys $weigths] {
    set value [dict get $weigths $item]
    puts $value
}
</code>

==== - dict exists ====
<code tcl>
dict exists $weigths a
</code>

==== - dict keys sort排序 ====
<code tcl>
lsort [dict keys $weigths]
</code>


==== - dict merge， 相当于copy ====

<code tcl>
dict merge ?dictionaryValue ...?

set dict_a [dict merge $dict_b]
set dict_a [dict merge $dict_b $dict_c]
</code>

Return a dictionary that contains the contents of each of the dictionaryValue arguments. Where two (or more) dictionaries contain a mapping for the same key, the resulting dictionary maps that key to the value according to the last dictionary on the command line containing a mapping for that key.



==== - dict 包 list ====
<code tcl>
% set a {1 2}
1 2
% set b {3 4}
3 4
% set mdict [dict create]
% dict set mdict key_0 $a
key_0 {1 2}
% dict set mdict key_1 $b
key_0 {1 2} key_1 {3 4}
% foreach key [dict keys $mdict] { foreach i [dict get $mdict $key] { puts "$key . $i"} }
key_0 . 1
key_0 . 2
key_1 . 3
key_1 . 4
</code>
===== - 条件判断 & loop循环控制 =====

==== - if elseif else ====
<code tcl>
if { $x>0 } {
    puts "x>0"
} elseif { $x＝＝1 } {
    puts "x==0"
} else {
    puts "other"
}
</code>

<code tcl>
set isTrue [expr {
    [info exists ::env(SOME_ENV_VAR)] &&
    [string is true -strict $::env(SOME_ENV_VAR)]
}]


set a "word"
set b "base"
if { [expr [regexp {wo} $a] && [regexp {ba} $b] ] } {
    puts "haha"
}
</code>



==== - while ====
<code tcl>
set i 8
while { $i>=0 } {
    puts "$i"
    incr i -1
}

set i 8
while { $i>=0 } {
    puts "$i"
    incr i -1
    if { $i == 2 } {
        break
        #continue
    }
}
</code>

==== - for ====

<code tcl>
set b " "
set loop_times 8
for {set i $loop_times} {$i>=0} {incr i -1} {
      lappend b $i
}
</code>


==== - foreach ====
<code tcl>
set list_b {1 2}
foreach i $list_b {
    puts "$i"
}
</code>

==== - switch ====
<code tcl>
switch $x {
    a -
    b {incr t1}
    c {incr t2}
    d { [expr 1*2] }
    default {incr t3}
}
</code>

其中 a 的后面跟一个'－'表示使用和下一个模式相同的脚本。

switch看起来还有行数限制，如果switch结构行数过多，可能导致语法错误，此时建议修改下写法，比如在switch结构里使用proc调用，这样代码显得更紧凑。


===== - proc 过程函数控制 =====

==== - 无参数 ====
<code tcl>

set xxx_var 0x3

proc helloWorld {} {
    global xxx_var
    puts "Hello, World!"
    puts "xxx_var = $xxx_var"
}
helloWorld

#  proc中，可以使用global xxx_var来使用proc之外的变量$xxx_var

</code>

==== - 带参数 ====

<code tcl>
proc add {a b} {
   return [expr $a+$b]
}
puts [add 10 30]
</code>

==== - 参数带默认值 ====
<code tcl>
proc add {a {b 100} } {
   return [expr $a+$b]
}
puts [add 10 30]
puts [add 10]
</code>


==== - 可变个数参数 ====

<code tcl>
###########用法1, 传入proc的是一个list变量
% proc calc_sum {numbers} {
    set sum 0
    foreach number $numbers {
      set sum  [expr $sum + $number]
        }
    return $sum
}
% puts [calc_sum {70 80 50 60}]
260
% calc_sum 70 80
wrong # args: should be "calc_sum numbers"
% calc_sum 70
70

###########用法2，参数以args结尾, args就代表不确定数量的多个参数

% proc calc_sum2 {args} {
    set sum 0
    foreach number $args {
      set sum  [expr $sum + $number]
        }
    return $sum
}
%
% calc_sum2 2
2
% calc_sum2 2 3
5
% calc_sum2 2 3 6
11
% calc_sum2 {70 80}
missing operator at _@_
in expression "0 + 70 _@_80"

</code>


===== - 文件 =====
==== - 文件操作模式 ====

^ 模式  ^ 说明                             ^
| r   | 只读                             |
| w   | 只写                             |
| a   | 追加写                            |
| r+  | 读写，文件必须存在                      |
| w+  | 读写，如果文件存在，就变成0文件。如果文件不存在就创建文件  |
| a+  | 读写，如果文件存在，只能追加写。如果文件不存在就创建文件   |

==== - 写文件 ====
<code tcl>
set fp [open "input.txt" w]
puts $fp "test0"
puts $fp "test1"
close $fp
</code>

==== - 读文件 ====
=== - 采用read方法 ===

read — Read from a channel， 一下把内容全部读出来

语法：''read channelId numChars''

<code tcl>
set fp [open "input.txt" r]
set file_data [read $fp]
puts "readout: $file_data"
close $fp
</code>

=== - 采用get一行方法 ===

gets — Read a line from a channel， 一行一行地读

语法：''gets channelId ?varName?''

<code tcl>
set fp [open "input.txt" r]
while { [gets $fp data] >= 0 } {
   puts "readout2: $data"
}
close $fp
</code>




==== - 判断文件 ====
=== - 是否可执行 ===

<code tcl>file executable name</code>
Returns 1 if file name is executable by the current user, 0 otherwise. On Windows, which does not have an executable attribute, the command treats all directories and any files with extensions exe, com, cmd or bat as executable.

=== - 是否存在 ===
<code tcl>file exists name</code>
Returns 1 if file name exists and the current user has search privileges for the directories leading to it, 0 otherwise.

=== - 是否是目录 ===
<code tcl>file isdirectory name</code>
Returns 1 if file name is a directory, 0 otherwise.

=== - 是否是普通文件 ===
<code tcl>file isfile name</code>
Returns 1 if file name is a regular file, 0 otherwise.

==== - 文件路径展开 ====

=== - 带*号匹配展开为绝对路径 ===

<code tcl>
glob — Return names of files that match patterns

set abs_path [glob ./out/linux_*/*/]
</code>

=== - 相对路径替换为绝对路径 ===
file normalize name

Returns a unique normalized path representation for the file-system object (file, directory, link, etc), whose string value can be used as a unique identifier for it. A normalized path is an absolute path which has all “../” and “./” removed. Also it is one which is in the “standard” format for the native platform. On Unix, this means the segments leading up to the path must be free of symbolic links/aliases (but the very last path component may be a symbolic link), and on Windows it also means we want the long form with that form's case-dependence (which gives us a unique, case-dependent path). The one exception concerning the last link in the path is necessary, because Tcl or the user may wish to operate on the actual symbolic link itself (for example file delete, file rename, file copy are defined to operate on symbolic links, not on the things that they point to).

<code tcl>
set abs_path [file normalize ../../]
</code>




===== - 随机数 =====

<code tcl>
    set rand_data0 [expr int([expr rand()*10000])]
    set rand_data1 [expr int([expr rand()*10000])]
    set rand_data2 [expr int([expr rand()*10000])]
    set rand_data3 [expr int([expr rand()*10000])]
    set rand_data4 [expr int([expr rand()*10000])]
</code>



===== - 调用系统shell命令 =====

<code tcsh>

exec uname -a
exec mkdir dir_a/subdir_b -p

</code>



===== - info命令 =====

<code tcl>

[info script]    #  用于显示当前脚本文件路径。

[info procs ?pattern?]
# If pattern is not specified, returns a list of all the names of Tcl command procedures in the current namespace. 
# If pattern is specified, only those procedure names in the current namespace matching pattern are returned.
# 包括用户自己写的proc函数

</code>

==== - 判断变量是否存在 ====
<code tcl>
% unset a
% if {[info exists a] && $a == 1} { echo "haha" }
% set a 1
1
% if {[info exists a] && $a == 1} { echo "haha" }
haha
% set a 0
0
% if {[info exists a] && $a == 1} { echo "haha" }
%
</code>

===== - 时间 =====

<code tcl>
clock microseconds     返回毫秒计时
clock seconds        返回秒计时
</code>

<code tcl>
set time1 [clock microseconds]
puts "time1 = $time1"

set time2 [clock microseconds]
puts "time1 = $time2"

set delta_time [expr $time2 - $time1]
puts "delta_time = $delta_time"


#获取系统时间
% clock format [clock seconds] -format {%Y%m%d-%H:%M}
20221122-10:28
%
</code>

===== - tcl command alias别名 =====

tcl支持一个命令有多个alias别名，比如一般来说echo和puts的行为是一样的，但是标准tcl不支持echo命令，可以使用alias来实现这一点。

<code tcl>
interp alias {} echo {} puts; #为标准tcl puts命令添加一个alias 别名，取名为echo


# other alias exapmles
interp alias {} getIndex {} lsearch {alpha beta gamma delta}

set idx [getIndex delta]
</code>


===== - json =====

参考：  https://core.tcl-lang.org/tcllib/doc/tcllib-1-18/embedded/www/tcllib/files/modules/json/json.html#1

https://core.tcl-lang.org/tcllib/doc/trunk/embedded/md/toc.md




==== - json2tcl ====

json::json2dict工作得还是很好的

<code tcl>

package require json

set jsonStr { \
  { "photos": { "page": 1, "pages": "726", "perpage": 3, "total": "7257", 
    "photo": [
      { "id": "6974156079", "owner": "74957296", "secret": "005d743f82", "server": "7197", "farm": 8, "title": "Kenya", "ispublic": 1, "isfriend": 0, "isfamily": 0 },
      { "id": "6822988100", "owner": "52857411", "secret": "56630c18e8", "server": "7183", "farm": 8, "title": "Gedi", "ispublic": 1, "isfriend": 0, "isfamily": 0 },
      { "id": "6822909640", "owner": "52857411", "secret": "f4e392ea36", "server": "7063", "farm": 8, "title": "Local", "ispublic": 1, "isfriend": 0, "isfamily": 0 }
    ] }, "stat": "ok" }
}

set d1 [json::json2dict $jsonStr]
puts "d1 is :"
puts $d1


foreach {key value} [dict get $d1] {
    set is [string is list $value]
    puts "$key -- $is -- "
    if {$key == "photos"} {
        foreach {key1 value1} [dict get $value] {
            puts "  $key1 -- $value1"

            if {$key1 == "photo"} {
                foreach value2 $value1 {
                    puts "    ==========$value2"
                    foreach {key3 value3} [dict get $value2] {
                        puts "    =========   $key3 -- $value3"
                    }
                }
            }
        }
    }
    #puts "$key--$value"
}



</code>

==== - tcl2json ====

以下这段代码是直接可以使用的。来自于

https://rosettacode.org/wiki/Rosetta_Code

https://rosettacode.org/wiki/JSON#Tcl

<code tcl>
package require Tcl 8.6
package require json::write

proc tcl2json value {
    # Guess the type of the value; deep *UNSUPPORTED* magic!
    regexp {^value is a (.*?) with a refcount} \
	[::tcl::unsupported::representation $value] -> type

    switch $type {
	string {
	    return [json::write string $value]
	}
	dict {
	    return [json::write object {*}[
		dict map {k v} $value {tcl2json $v}]]
	}
	list {
	    return [json::write array {*}[lmap v $value {tcl2json $v}]]
	}
	int - double {
	    return [expr {$value}]
	}
	booleanString {
	    return [expr {$value ? "true" : "false"}]
	}
	default {
	    # Some other type; do some guessing...
	    if {$value eq "null"} {
		# Tcl has *no* null value at all; empty strings are semantically
		# different and absent variables aren't values. So cheat!
		return $value
	    } elseif {[string is integer -strict $value]} {
		return [expr {$value}]
	    } elseif {[string is double -strict $value]} {
		return [expr {$value}]
	    } elseif {[string is boolean -strict $value]} {
		return [expr {$value ? "true" : "false"}]
	    }
	    return [json::write string $value]
	}
    }
}



set d [dict create blue [list 1 2] ocean water book {a b c d}]
puts [tcl2json $d]




dict set ages zhangsan 30
dict set ages lili 28

dict set addr shu  "guanzhou"
dict set addr lv  "suzhou"
dict set addr cc  [list cc1 cc2]
#set addr [list xx0 xx1]

dict set ages misc $addr
puts [tcl2json $ages]

</code>

输出：输出格式优美，可读性强。

<code>
{
    "blue"  : ["1","2"],
    "ocean" : "water",
    "book"  : "a b c d"
}
{
    "zhangsan" : 30,
    "lili"     : 28,
    "misc"     : {
        "shu" : "guanzhou",
        "lv"  : "suzhou",
        "cc"  : ["cc1","cc2"]
    }
}
</code>


==== - printtcl ====
此处是为了打印tcl变量的值，支持普通变量的dict & list， 但其实使用json格式来展示打印会更好。 tcl2json

<code tcl>
package require json
 
set jsonStr { \
  { "photos": { "page": 1, "pages": "726", "perpage": 3, "total": "7257", 
    "photo": [
      { "id": "6974156079", "owner": "74957296", "secret": "005d743f82", "server": "7197", "farm": 8, "title": "Kenya", "ispublic": 1, "isfriend": 0, "isfamily": 0 },
      { "id": "6822988100", "owner": "52857411", "secret": "56630c18e8", "server": "7183", "farm": 8, "title": "Gedi", "ispublic": 1, "isfriend": 0, "isfamily": 0 },
      { "id": "6822909640", "owner": "52857411", "secret": "f4e392ea36", "server": "7063", "farm": 8, "title": "Local", "ispublic": 1, "isfriend": 0, "isfamily": 0 }
    ] }, "stat": "ok" }
}
 
set d1 [json::json2dict $jsonStr]
puts "d1 is :"
puts $d1
 
proc printtcl {value {prefix ""}} {
    # Guess the type of the value; deep *UNSUPPORTED* magic!
    regexp {^value is a (.*?) with a refcount} \
	[::tcl::unsupported::representation $value] -> type

    switch $type {
	dict {
		dict map {k v} $value {
          puts "$prefix\key:$k"
          printtcl $v "$prefix  "
        }
	}
	list {
	    lmap v $value {
            puts "$prefix\list item:\["
            printtcl $v "$prefix  "
            puts "$prefix\list item:\]"
        }
	}
	default {
	    puts "$prefix$value"
	}
    }
}
printtcl $d1
 
</code>

输出：

<code>
d1 is :
photos {page 1 pages 726 perpage 3 total 7257 photo {{id 6974156079 owner 74957296 secret 005d743f82 server 7197 farm 8 title Kenya ispublic 1 isfriend 0 isfamily 0} {id 6822988100 owner 52857411 secret 56630c18e8 server 7183 farm 8 title Gedi ispublic 1 isfriend 0 isfamily 0} {id 6822909640 owner 52857411 secret f4e392ea36 server 7063 farm 8 title Local ispublic 1 isfriend 0 isfamily 0}}} stat ok
key:photos
  key:page
    1
  key:pages
    726
  key:perpage
    3
  key:total
    7257
  key:photo
    list item:[
      key:id
        6974156079
      key:owner
        74957296
      key:secret
        005d743f82
      key:server
        7197
      key:farm
        8
      key:title
        Kenya
      key:ispublic
        1
      key:isfriend
        0
      key:isfamily
        0
    list item:]
    list item:[
      key:id
        6822988100
      key:owner
        52857411
      key:secret
        56630c18e8
      key:server
        7183
      key:farm
        8
      key:title
        Gedi
      key:ispublic
        1
      key:isfriend
        0
      key:isfamily
        0
    list item:]
    list item:[
      key:id
        6822909640
      key:owner
        52857411
      key:secret
        f4e392ea36
      key:server
        7063
      key:farm
        8
      key:title
        Local
      key:ispublic
        1
      key:isfriend
        0
      key:isfamily
        0
    list item:]
key:stat
  ok
</code>

===== - 其它注意 =====

  - 标准tcl不支持''echo''命令（打印信息请使用''puts''命令），有些工具支持可能是支持自己作了功能增强。