tcl/tk demo

环境及版本说明:

OSX10.9

tclsh -> tclsh8.5

wish -> wish8.5

查看本机运行环境:

 which wish;
2 /usr/bin/wish

 which tclsh;
 /usr/bin/tclsh

Demo功能说明:

用户登录窗口,输入用户名,密码.与文件中存储内容校验,如果相等,则提示"登录成功",否则提示"是否需要新建用户",点击"否"退出messageBox,点击"是"新建用户.内容追加写入文件.

 #!/usr/bin/wish -f
 #
 # this is test login, Tk-style

 set filename "usrfile.pwd";

 proc splitf { str index } {
     set y [ split $str | ];
     list  $y;
     set w [ lindex $y $index ];
     return $w;
 }

 proc checkinfo {name pwd} {
     global filename;
     set iflag ;
     set isUser ;

     if { $name eq "" || $pwd eq "" } {
         return ;
     }

     set fileId [ open $filename r ];
     while { [ gets $fileId line ] >=  } {
         set nameInfile [ splitf $line  ];
         set cmp [ string compare $name $nameInfile ];

         if { $cmp !=  } {
             set isUser [ expr $isUser +  ];
         } elseif { $cmp ==  } {
             set pwdInfile [ splitf $line  ];
             set cmp [ string compare $pwd $pwdInfile ];
             if { $cmp ==  } {
                 close $fileId;
                 return ; #login successful
             } else {
                 close $fileId;
                 return ; #err user pwd
             }
         }
         set iflag [ expr $iflag +  ];
     }
     close $fileId;

     if { $iflag ==  } {
         return ; #file is null,creat user;
     }
     if { $iflag == $isUser } {
         return ; #creat user
     }
 }

 proc process { uname pwd } {
     global filename;
     set returnCheck [ checkinfo $uname $pwd ];
     switch -- $returnCheck {
          { tk_messageBox -type ok -message "you are login successful" }
          { set answer [ tk_messageBox -type yesno -icon question \
                  -message "you need creat a user" ] ;
                 switch -- $answer {
                     no { }
                     yes { puts stdout [ createusr $uname $pwd ] }
                 }
             }
         //003 { tk_messageBox -type ok -icon warning -message "$filename file is null" }
          { tk_messageBox -type ok -icon error -message "input err of user pwd" }
          { tk_messageBox -type ok -icon info -message "user and pwd is not null" }
         default { tk_messageBox -type ok -icon error -message "system err" }
     }
 }

 proc createusr { uname pwd } {
     global filename;
     set fileId [ open $filename a ];
     puts $fileId "$uname|$pwd" ;
     close $fileId;
     return ;
 }
 wm title . LOGIN
 wm maxsize .
 wm minsize .
 wm resizable .
 wm geometry . 500x300++

 label .ulname -text "userName"

 entry .tuname -textvariable name 

 label .ulpwd -text "userPwd"

 entry .tupwd -textvariable pwd

 button .bOK -text OK \
   -command { puts stdout [ process $name $pwd] }

 button .bExit -text Exit \
   -command {exit}

 place .ulname -x  -y
 place .tuname -x  -y
 place .ulpwd -x  -y
 place .tupwd -x  -y  

 place .bOK -x  -y
 place .bExit -x  -y 

 wish tk.tcl

配置文件格式:

 cat usrfile.pwd
2 userTmp|abc123

此Demo涉及控件,语法.足够日常使用.望对新学者有点帮助.

特别需要注意:

1- 所有的关键字与{ 等之间一定要有空格,否则无法解析.

错误: proc sum{arg1 arg2}{

正确: proc sum { arg1 arg2 } {

2- proc if switch等需要用{}包含的body 左括号一定要写到 if {} { 与关键字同行

 proc sum { arg1 arg2 }

 {

 　　....

 }

以上代码将提示:

Error in startup script: wrong # args: should be "proc name args body"

while executing

"proc sum {arg1 arg2} "

(file "a.tcl" line 3)

需要修改为:

 proc sum { arg1 arg2 } {

 　　....

 }

学习网站:

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