环境及版本说明:
OSX10.9
tclsh -> tclsh8.5
wish -> wish8.5
查看本机运行环境:
1 which wish; 2 /usr/bin/wish
1 which tclsh; 2 /usr/bin/tclsh
Demo功能说明:
用户登录窗口,输入用户名,密码.与文件中存储内容校验,如果相等,则提示"登录成功",否则提示"是否需要新建用户",点击"否"退出messageBox,点击"是"新建用户.内容追加写入文件.
1 #!/usr/bin/wish -f
2 #
3 # this is test login, Tk-style
4
5 set filename "usrfile.pwd";
6
7 proc splitf { str index } {
8 set y [ split $str | ];
9 list $y;
10 set w [ lindex $y $index ];
11 return $w;
12 }
13
14 proc checkinfo {name pwd} {
15 global filename;
16 set iflag 0;
17 set isUser 0;
18
19 if { $name eq "" || $pwd eq "" } {
20 return 005;
21 }
22
23 set fileId [ open $filename r ];
24 while { [ gets $fileId line ] >= 0 } {
25 set nameInfile [ splitf $line 0 ];
26 set cmp [ string compare $name $nameInfile ];
27
28 if { $cmp != 0 } {
29 set isUser [ expr $isUser + 1 ];
30 } elseif { $cmp == 0 } {
31 set pwdInfile [ splitf $line 1 ];
32 set cmp [ string compare $pwd $pwdInfile ];
33 if { $cmp == 0 } {
34 close $fileId;
35 return 001; #login successful
36 } else {
37 close $fileId;
38 return 004; #err user pwd
39 }
40 }
41 set iflag [ expr $iflag + 1 ];
42 }
43 close $fileId;
44
45 if { $iflag == 0 } {
46 return 002; #file is null,creat user;
47 }
48 if { $iflag == $isUser } {
49 return 002; #creat user
50 }
51 }
52
53 proc process { uname pwd } {
54 global filename;
55 set returnCheck [ checkinfo $uname $pwd ];
56 switch -- $returnCheck {
57 001 { tk_messageBox -type ok -message "you are login successful" }
58 002 { set answer [ tk_messageBox -type yesno -icon question
59 -message "you need creat a user" ] ;
60 switch -- $answer {
61 no { }
62 yes { puts stdout [ createusr $uname $pwd ] }
63 }
64 }
65 //003 { tk_messageBox -type ok -icon warning -message "$filename file is null" }
66 004 { tk_messageBox -type ok -icon error -message "input err of user pwd" }
67 005 { tk_messageBox -type ok -icon info -message "user and pwd is not null" }
68 default { tk_messageBox -type ok -icon error -message "system err" }
69 }
70 }
71
72 proc createusr { uname pwd } {
73 global filename;
74 set fileId [ open $filename a ];
75 puts $fileId "$uname|$pwd" ;
76 close $fileId;
77 return 1;
78 }
79 wm title . LOGIN
80 wm maxsize . 500 300
81 wm minsize . 500 300
82 wm resizable . 500 300
83 wm geometry . 500x300+300+200
84
85 label .ulname -text "userName"
86
87 entry .tuname -textvariable name
88
89 label .ulpwd -text "userPwd"
90
91 entry .tupwd -textvariable pwd
92
93 button .bOK -text OK
94 -command { puts stdout [ process $name $pwd] }
95
96 button .bExit -text Exit
97 -command {exit}
98
99
100 place .ulname -x 110 -y 50
101 place .tuname -x 200 -y 50
102 place .ulpwd -x 110 -y 100
103 place .tupwd -x 200 -y 100
104
105 place .bOK -x 150 -y 150
106 place .bExit -x 280 -y 150
1 wish tk.tcl
配置文件格式:
1 cat usrfile.pwd
2 userTmp|abc123
此Demo涉及控件,语法.足够日常使用.望对新学者有点帮助.
特别需要注意:
1- 所有的关键字与{ 等之间一定要有空格,否则无法解析.
错误: proc sum{arg1 arg2}{
正确: proc sum { arg1 arg2 } {
2- proc if switch等需要用{}包含的body 左括号一定要写到 if {} { 与关键字同行
1 proc sum { arg1 arg2 } 2 3 { 4 5 .... 6 7 }
以上代码将提示:
Error in startup script: wrong # args: should be "proc name args body"
while executing
"proc sum {arg1 arg2} "
(file "a.tcl" line 3)
需要修改为:
1 proc sum { arg1 arg2 } { 2 3 .... 4 5 }
学习网站:
http://www.tcl.tk/man/tcl8.5/TclCmd/contents.htm
http://www2.tcl.tk/1062
http://blog.csdn.net/dulixin/article/category/366323
read-only access to git repository:
git clone https://github.com/galoishelley/tcltk